       SUBROUTINE PRESIG
C
C *** ************************************************************** ***
C *** *                                                            * ***
C *** *  COPYRIGHT (C) 1989 by The University of Texas at Austin   * ***
C *** *                                                            * ***
C *** * Permission is hereby granted to use, modify, copy, and     * ***
C *** * distribute this software and its documentation for any     * ***
C *** * purpose only without profit, provided that the above       * ***
C *** * Copyright Notice appears in all copies and that both the   * ***
C *** * Copyright Notice and this Permission Notice appears in     * ***
C *** * every copy of supporting documentation.  No title to nor   * ***
C *** * ownership of the software is transferred hereby.  The name * ***
C *** * of The University of Texas at Austin shall not be used in  * ***
C *** * advertising or publicity related to the distribution of    * ***
C *** * the software without specific, written, prior permission.  * ***
C *** * This software is provided as-delivered without expressed   * ***
C *** * or implied warranty.  The University of Texas at Austin    * ***
C *** * makes no representation about the suitability of this      * ***
C *** * software for any purpose and accepts no responsibility for * ***
C *** * its use.                                                   * ***
C *** *                                                            * ***
C *** ************************************************************** ***
C *** *                                                            * ***
C *** * This program is free software; you can redistribute it     * ***
C *** * and/or modify it under the terms of the GNU General Public * ***
C *** * License as published by the Free Software Foundation;      * ***
C *** * either version 2 of the License, or (at your option) any   * ***
C *** * later version.                                             * ***
C *** *                                                            * ***
C *** * This program is distributed in the hope that it will be    * ***
C *** * useful, but WITHOUT ANY WARRANTY; without even the implied * ***
C *** * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR    * ***
C *** * PURPOSE.  See the GNU General Public License for more      * ***
C *** * details.                                                   * ***
C *** *                                                            * ***
C *** * You should have received a copy of the GNU General Public  * ***
C *** * License along with this program; if not, write to the Free * ***
C *** * Software Foundation, Inc., 51 Franklin Street, Fifth       * ***
C *** * Floor, Boston, MA 02110-1301, USA.                         * ***
C *** *                                                            * ***
C *** * For more information: http://www.gnu.org/licenses/gpl.html * ***
C *** *                                                            * ***
C *** ************************************************************** ***
C
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'USER'
C8601 FORMAT(2H99,2I2,6X,F6.1)
C+602 FORMAT(2H99,2I2,F7.1)
C4701 FORMAT(36H PRE-TIMED SIGNAL SETTINGS - PHASE =,I2,9H ICAMPO =,I3,
C4   *       9H ICAMPC =,I3,5H TP =,F6.1,9H TCAMPH =,F6.1,5H TR =,F6.1)
C
C-----SUBROUTINE PRESIG SIMULATES THE PRE-TIMED SIGNAL CONTROLLER
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'PRESIG'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C-----INCREMENT THE TIME INTO THE PHASE
      TP = TP + DT
C-----DECREMENT THE TIME REMAINING IN THE PHASE
      TR = TR - DT
                    IF ( TR . LT . 0.5D0*DT )    TR = 0.0D0
C-----SET THE OLD CAM STACK POSITION TO THE CURRENT CAM STACK POSITION
      ICAMPO = ICAMPC
C-----IF THE TIME REMAINING IN THE PHASE IS GT 0.0 THEN GO TO 1010 AND
C-----REMAIN IN THIS PHASE
                    IF ( TR . GT . 0.0D0 )       GO TO 1010
C-----THERE IS NO TIME REMAINING FOR THIS PHASE THUS GO TO THE NEXT CAM
C-----STACK POSITION
      ICAMPC = ICAMPC + 1
                    IF ( ICAMPC . GT . NCAMSP )  ICAMPC = 1
C-----GET THE PHASE NUMBER FOR THIS CAM STACK POSITION
      ICPHAS = ICAMPH(ICAMPC)
C-----RESET THE TIME INTO THE PHASE AND THE TIME REMAINING IN THIS PHASE
      TP = 0.0D0
      TR = TCAMSP(ICAMPC)
C8    WRITE (IQD,601) ICPHAS,ICAMPC,(TIME+DT)
C+    WRITE (IDH,602) ICPHAS,ICAMPC,(TIME+DT)
 1010 CONTINUE
C4                  IF ( TIME . LT . TPRINT )    GO TO 101
C4    WRITE (6,701) ICPHAS,ICAMPO,ICAMPC,TP,TCAMSP(ICAMPC),TR
C4101 CONTINUE
      RETURN
      END                                                               PRESIG
C
C
C
      SUBROUTINE ACTSIG
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'USER'
      LOGICAL           IDFP,IDOG
C[    LOGICAL           IDFPS,IDOGS
      INTEGER           I,II,IPCLTO,IPHASO,NPCLTO
C4    INTEGER           JJ
      DOUBLE PRECISION  TMAG1,TMAG2
C8601 FORMAT(2H88,2I2,6X,F6.1)
C+602 FORMAT(2H88,2I2,F7.1)
C4701 FORMAT(9H ICAMPC =,I3,9H ICPHAS =,I3,8H INTER =,I3,5H TP =,
C4   *       F5.1,5H TR =,F5.1)
C4702 FORMAT(9H ICAMPC =,I3,9H ICPHAS =,I3,8H INTER =,I3,5H TP =,
C4   *       F5.1,5H TR =,F5.1,6H NLD =,I3,6H LLD =,10I2)
C4703 FORMAT(10H LDTRIP = ,20L1,8H IDOG = ,L1,8H IDOR = ,L1,
C4   *       6H EOM =,F5.1,6H TII =,F5.1,6H TVI =,F5.1,6H TMX =,F5.1)
C;704 FORMAT(19H GAP-OUT FROM PHASE,I2,10H IDUALL = ,A3)
C;705 FORMAT(28H MAG NOT SATISFIED FOR PHASE,I2,5H TP =,F6.1,
C;   *       8H TMAG1 =,F6.1,8H TMAG2 =,F6.1,9H NEXTPH =,I2,4H I =,I2)
C;706 FORMAT(19H MAX-OUT FROM PHASE,I2,10H IDUALL = ,A3,
C;   *       16H TMX(ICPHAS+1) =,F6.1,16H TMX(ICPHAS+2) =,F6.1)
C;707 FORMAT(6H PHASE,I2,9H NPCLTO =,I2,9H LPHNXT =,7I4)
C;708 FORMAT(9H NGAPPH =,I5,9H NMAXPH =,I5,6H TCI =,F5.1,6H TAR =,F5.1,
C;   *       9H NEXTPH =,I2,4H I =,I2)
C4709 FORMAT(9H ICAMPC =,I3,9H ICPHAS =,I3,10H IDUALL = ,A3,
C4   *       6H TII =,F5.1,6H TVI =,F5.1,6H TCI =,F5.1,6H TAR =,F5.1)
C
C-----SUBROUTINE ACTSIG SIMULATES THE SEMI-ACTUATED OR FULL-ACTUATED
C-----SIGNAL CONTROLLER
C
C[    IDFPS      = .TRUE.
C[    IDOGS      = .TRUE.
C[    I          = -2147483647
C[    II         = -2147483647
C[    IPCLTO     = -2147483647
C[    IPHASO     = -2147483647
C[    NPCLTO     = -2147483647
C[    TMAG1      = -2147483647.0
C[    TMAG2      = -2147483647.0
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'ACTSIG'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C-----SAVE TRAFFIC DETECTOR ACTUATIONS FOR ANIMATION
                    IF ( NLOOPS . LE . 0 )       GO TO 1006
      DO 1003  I = 1 , NLOOPS
      II=LLOOPS(I)
      CALL  PRE1LD  ( II )
 1003 CONTINUE
 1006 CONTINUE
C-----SET THE OLD CAM STACK POSITION TO THE CURRENT CAM STACK POSITION
      ICAMPO = ICAMPC
C-----INCREMENT THE TIME INTO THE PHASE
      TP = TP + DT
C-----DECREMENT THE TIME REMAINING IN THE PHASE
      TR = TR - DT
                    IF ( TR . LT . 0.5D0*DT )    TR = 0.0D0
C4                  IF ( TIME . LT . TPRINT )    GO TO 102
C4    II = NLD(ICPHAS)
C4                  IF ( II . GT . 0 )           GO TO 101
C4    WRITE (6,701) ICAMPC,ICPHAS,INTER(1),TP,TR
C4    GO TO 102
C4101 CONTINUE
C4    WRITE (6,702) ICAMPC,ICPHAS,INTER(1),TP,TR,II,
C4   *              (LLD(JJ,ICPHAS),JJ=1,II)
C4102 CONTINUE
C-----PROCESS BASED ON THE INTERVAL WITHIN THE PHASE
C-----(G=GREEN  YC=YELLOW CLEARANCE  RC=ALL-RED CLEARANCE)
C-----         G    YC   RC
      GO TO ( 1010,5010,6010 ) , INTER(1)
 1010 CONTINUE
C-----THE SIGNAL IS IN THE GREEN SIGNAL INDICATION
C-----CHECK THE DEMAND FOR THE CURRENT PHASE FOR ONLY THE POSITIVE
C-----DETECTOR CONNECTIONS AND RETURN THE DEMAND ON GREEN
      CALL  CHKDFP  ( IDOG,ICPHAS,1 )
C[    IDOGS      = .FALSE.
C-----IF THERE ALREADY IS A DEMAND ON RED THEN GO TO 1050 AND CONTINUE
                    IF ( IDOR(1,1) )             GO TO 1050
            IF ( IMINOR(ICPHAS) . EQ . INO )     GO TO 1020
C-----THE CURRENT SIGNAL PHASE IS THE MINOR PHASE FOR THE PARENT/MINOR
C-----SIGNAL PHASE CASE THUS THERE IS ALWAYS DEMAND ON RED
      IDOR(1,1) = .TRUE.
      GO TO 1050
 1020 CONTINUE
C-----CHECK EACH SIGNAL PHASE FOR DEMAND ON RED
      DO 1040  II = 1 , NPHASE
      I = LPHASE(II)
C-----IF THE SIGNAL PHASE TO BE CHECKED IS THE CURRENT SIGNAL PHASE THEN
C-----GO TO 1040 AND SKIP TO THE NEXT SIGNAL PHASE
                    IF ( I . EQ . ICPHAS )       GO TO 1040
                    IF ( I . EQ . IARRPH )       GO TO 1040
                    IF ( IDUALL(ICPHAS).EQ.INO ) GO TO 1030
C-----THE CURRENT SIGNAL PHASE IS A DUAL LEFT PHASE THUS THE NEXT TWO
C-----PHASES AFTER IT MUST BE THE INDIVIDUAL LEFT TURN SIGNAL PHASES AND
C-----NEITHER OF THESE SINGLE LEFT TURN SIGNAL PHASES SHOULD REGISTER A
C-----DEMAND ON RED AND CAUSE THE DUAL LEFT PHASE TO PASS INTO A SINGLE
C-----LEFT TURN SIGNAL PHASE THUS IF THE SIGNAL PHASE BEING CHECKED IS
C-----EITHER OF THE SINGLE LEFT TURN SIGNAL PHASES THEN GO TO 1040 AND
C-----SKIP TO THE NEXT SIGNAL PHASE
                    IF ( I . EQ . ICPHAS+1 )     GO TO 1040
                    IF ( I . EQ . ICPHAS+2 )     GO TO 1040
 1030 CONTINUE
C-----CHECK THE DEMAND FOR THE SIGNAL PHASE BEING CHECKED USING BOTH THE
C-----POSITIVE AND NEGATIVE DETECTOR CONNECTIONS AND RETURN THE DEMAND
C-----ON RED
C[    IF ( I                  .EQ.-2147483647   )STOP 'ACTSIG I      01'
      CALL  CHKDFP  ( IDOR(1,1),I,2 )
C-----IF THERE IS A DEMAND ON RED THEN GO TO 1050 AND CONTINUE
                    IF ( IDOR(1,1) )             GO TO 1050
C-----END OF SIGNAL PHASE LOOP
 1040 CONTINUE
 1050 CONTINUE
C4                  IF ( TIME . LT . TPRINT )    GO TO 103
C[    IF ( IDOGS )                               STOP 'ACTSIG IDOG   01'
C4    WRITE (6,703) (LDTRIP(II),II=1,20),IDOG,IDOR(1,1),EOM(1),
C4   *              TII(ICPHAS),TVI(ICPHAS),TMX(ICPHAS)
C4103 CONTINUE
C-----IF THERE IS A DEMAND ON GREEN THIS DT AND THE TIME INTO THE SIGNAL
C-----PHASE IS GE THE INITIAL INTERVAL FOR THE SIGNAL PHASE THEN SET THE
C-----TIME REMAINING IN THIS SIGNAL PHASE TO THE VEHICLE INTERVAL FOR
C-----THIS SIGNAL PHASE
C[    IF ( IDOGS )                               STOP 'ACTSIG IDOG   02'
      IF ( IDOG . AND . (TP.GE.TII(ICPHAS)) )    TR = TVI(ICPHAS)
C-----IF THERE IS DEMAND ON RED AND THE END OF MAX HAS NOT BEEN SET THEN
C-----SET END OF MAX TO THE MAXIMUM OF THE TIME INTO THE SIGNAL PHASE
C-----PLUS THE MAXIMUM EXTENSION AFTER DEMAND ON RED FOR THIS SIGNAL
C-----PHASE AND THE INITIAL INTERVAL PLUS THE VEHICLE INTERVAL FOR THIS
C-----SIGNAL PHASE
      IF ( IDOR(1,1) . AND . (EOM(1).EQ.TIMERR) )
     *          EOM(1) = DMAX1( TP+TMX(ICPHAS),TII(ICPHAS)+TVI(ICPHAS) )
C-----IF THERE HAS BEEN A DEMAND ON RED THUS END OF MAX HAS BEEN SET
C-----AND THE TIME REMAINING IN THIS SIGNAL PHASE IS LE 0 THEN GO TO
C-----2010 AND GAP-OUT THIS SIGNAL PHASE
      IF ( (EOM(1).NE.TIMERR).AND.(TR.LE.0.0D0) )GO TO 2010
C-----IF THE TIME INTO THE PHASE FOR THIS SIGNAL PHASE IS GE END OF MAX
C-----THEN GO TO 3010 AND MAX-OUT THIS SIGNAL PHASE
                    IF ( TP . GE . EOM(1) )      GO TO 3010
      IF ( (TR.LE.0.0D0) .AND. (IARRPH.NE.0) )   GO TO 2010
C-----IF THE TIME REMAINING FOR THIS SIGNAL PHASE IS LT THE VEHICLE
C-----INTERVAL FOR THIS SIGNAL PHASE THEN GO TO 7010 AND CLEAR TRAFFIC
C-----DETECTOR ACTUATIONS ELSE THE TIME REMAINING FOR THIS SIGNAL PHASE
C-----WAS JUST SET TO THE VEHICLE INTERVAL FOR THIS SIGNAL PHASE THUS
C-----SET ALL DETECTORS CONNECTED POSITIVE TO THIS SIGNAL PHASE TO FALSE
C-----(DEMAND HAS BEEN SATISFIED BY RESETTING THE TIME REMAINING IN THIS
C-----SIGNAL PHASE TO THE VEHICLE INTERVAL FOR THIS SIGNAL PHASE)
                    IF ( TR . LT . TVI(ICPHAS) ) GO TO 7010
C-----SET THE DETECTORS CONNECTED POSITIVE TO THE CURRENT SIGNAL PHASE
C-----TO FALSE
      CALL  SETLDF
      GO TO 7010
 2010 CONTINUE
C-----GAP-OUT FROM THE CURRENT SIGNAL PHASE (DOG=F, DOR=T, AND TR LE 0)
C-----SET THE STARTING INDEX NUMBER FOR THE LPHNXT ARRAY OF /PHASES/
C-----THAT THE NEXT SIGNAL PHASE FINDER WILL USE TO 1 (START THE AT
C-----BEGINNING OF THE LPHNXT ARRAY)
      IPCLTO = 1
C;                  IF ( TIME . LT . TPRINT )    GO TO 104
C;    WRITE (6,704) ICPHAS,IDUALL(ICPHAS)
C;104 CONTINUE
                    IF ( TIME . LE . STRTIM )    GO TO 2020
C-----INCREMENT THE NUMBER OF GAP-OUTS FOR THIS SIGNAL PHASE AND ADD THE
C-----TIME INTO THIS SIGNAL PHASE FOR THE AVERAGE TIME INTO THE SIGNAL
C-----PHASE FOR GAP-OUT
      NGAPPH(ICPHAS) = NGAPPH(ICPHAS) + 1
      TGAPPH(ICPHAS) = TGAPPH(ICPHAS) + TP
 2020 CONTINUE
                    IF ( IDUALL(ICPHAS).EQ.IYES )GO TO 2030
C-----THIS SIGNAL PHASE IS NOT THE DUAL LEFT PHASE THUS SET THE
C-----DETECTORS CONNECTED POSITIVE TO THE CURRENT SIGNAL PHASE TO FALSE
      CALL  SETLDF
      GO TO 4010
 2030 CONTINUE
C-----SET TMAG1 TO THE MINIMUM ASSURED GREEN FOR THE FIRST SINGLE LEFT
C-----SIGNAL PHASE FOLLOWING THE DUAL LEFT SIGNAL PHASE
      TMAG1 = TII(ICPHAS+1) + TVI(ICPHAS+1)
C-----SET TMAG2 TO THE MINIMUM ASSURED GREEN FOR THE SECOND SINGLE LEFT
C-----SIGNAL PHASE FOLLOWING THE DUAL LEFT SIGNAL PHASE
      TMAG2 = TII(ICPHAS+2) + TVI(ICPHAS+2)
                    IF ( TMAG2 - TMAG1 )         2040 , 4010 , 2050
 2040 CONTINUE
C-----TMAG1 IS LONGER THAN TMAG2 THUS IF THE TIME INTO THE SIGNAL PHASE
C-----IS GE TMAG1 THEN GO TO 4010 AND FIND THE NEXT SIGNAL PHASE ELSE
C-----SET THE NEXT SIGNAL PHASE TO THE FIRST SINGLE LEFT TURN SIGNAL
C-----PHASE (THE MINIMUM ASSURED GREEN FOR THE FIRST SINGLE LEFT TURN
C-----SIGNAL PHASE HAS NOT BEEN SATISFIED)
C[    IF ( TMAG1              .EQ.-2147483647.0 )STOP 'ACTSIG TMAG1  01'
                    IF ( TP . GE . TMAG1 )       GO TO 4010
      NEXTPH = ICPHAS + 1
      I = 1
      GO TO 2060
 2050 CONTINUE
C-----TMAG2 IS LONGER THAN TMAG1 THUS IF THE TIME INTO THE SIGNAL PHASE
C-----IS GE TMAG2 THEN GO TO 4010 AND FIND THE NEXT SIGNAL PHASE ELSE
C-----SET THE NEXT SIGNAL PHASE TO THE SECOND SINGLE LEFT TURN SIGNAL
C-----PHASE (THE MINIMUM ASSURED GREEN FOR THE SECOND SINGLE LEFT TURN
C-----SIGNAL PHASE HAS NOT BEEN SATISFIED)
C[    IF ( TMAG2              .EQ.-2147483647.0 )STOP 'ACTSIG TMAG2  01'
                    IF ( TP . GE . TMAG2 )       GO TO 4010
      NEXTPH = ICPHAS + 2
      I = 2
 2060 CONTINUE
C;                  IF ( TIME . LT . TPRINT )    GO TO 105
C;    WRITE (6,705) ICPHAS,TP,TMAG1,TMAG2,NEXTPH,I
C;105 CONTINUE
C-----SET THE FLAG FOR MINIMUM ASSURED GREEN HAS NOT BEEN SATISFIED AND
C-----ENTER THE YELLOW CLEARANCE INTERVAL
      MAGSAT = .FALSE.
      GO TO 4050
 3010 CONTINUE
C-----MAX-OUT FROM THE CURRENT SIGNAL PHASE (DOG=DOR=T AND TP GE EOM)
C-----SET THE STARTING INDEX NUMBER FOR THE LPHNXT ARRAY OF /PHASES/
C-----THAT THE NEXT SIGNAL PHASE FINDER WILL USE TO 1 (START THE AT
C-----BEGINNING OF THE LPHNXT ARRAY)
      IPCLTO = 1
C;                  IF ( TIME . LT . TPRINT )    GO TO 106
C;    WRITE (6,706) ICPHAS,IDUALL(ICPHAS),TMX(ICPHAS+1),TMX(ICPHAS+2)
C;106 CONTINUE
                    IF ( TIME . LE . STRTIM )    GO TO 3020
C-----INCREMENT THE NUMBER OF MAX-OUTS FOR THIS SIGNAL PHASE AND ADD THE
C-----TIME INTO THIS SIGNAL PHASE FOR THE AVERAGE TIME INTO THE SIGNAL
C-----PHASE FOR MAX-OUT
      NMAXPH(ICPHAS) = NMAXPH(ICPHAS) + 1
      TMAXPH(ICPHAS) = TMAXPH(ICPHAS) + TP
 3020 CONTINUE
C-----IF THIS SIGNAL PHASE IS NOT A DUAL LEFT SIGNAL PHASE THEN GO TO
C-----4010 AND FIND THE NEXT SIGNAL PHASE
                    IF ( IDUALL(ICPHAS).EQ.INO ) GO TO 4010
C-----THE CURRENT SIGNAL PHASE IS A DUAL LEFT SIGNAL PHASE THUS SET THE
C-----STARTING INDEX NUMBER FOR THE LPHNXT ARRAY OF /PHASES/ THAT THE
C-----NEXT SIGNAL PHASE FINDER WILL USE TO 3 (SKIP BOTH SINGLE LEFT TURN
C-----SIGNAL PHASES AFTER THE DUAL LEFT SIGNAL PHASE MAX-OUT)
      IPCLTO = 3
            IF ( TMX(ICPHAS+2) - TMX(ICPHAS+1) ) 3030 , 4010 , 3040
 3030 CONTINUE
C-----THE MAXIMUM EXTENSION AFTER DEMAND ON RED FOR THE FIRST SINGLE
C-----LEFT TURN SIGNAL PHASE IS GT THE MAXIMUM EXTENSION AFTER DEMAND ON
C-----RED FOR THE SECOND SINGLE LEFT TURN SIGNAL PHASE THUS SET THE NEXT
C-----SIGNAL PHASE TO THE FIRST SINGLE LEFT TURN SIGNAL PHASE AND ENTER
C-----THE YELLOW CLEARANCE INTERVAL
      NEXTPH = ICPHAS + 1
      I = 1
      GO TO 4050
 3040 CONTINUE
C-----THE MAXIMUM EXTENSION AFTER DEMAND ON RED FOR THE SECOND SINGLE
C-----LEFT TURN SIGNAL PHASE IS GT THE MAXIMUM EXTENSION AFTER DEMAND ON
C-----RED FOR THE FIRST SINGLE LEFT TURN SIGNAL PHASE THUS SET THE NEXT
C-----SIGNAL PHASE TO THE SECOND SINGLE LEFT TURN SIGNAL PHASE AND ENTER
C-----THE YELLOW CLEARANCE INTERVAL
      NEXTPH = ICPHAS + 2
      I = 2
      GO TO 4050
 4010 CONTINUE
C-----FORCED CLEARANCES HAVE NOT BEEN MANDATED THUS CHECK EACH SIGNAL
C-----PHASE THAT THIS SIGNAL PHASE CAN CLEAR TO STARTING AT IPCLTO AND
C-----SET THE NEXT SIGNAL PHASE TO THE FIRST SIGNAL PHASE ON THE LIST OF
C-----SIGNAL PHASES THAT THIS SIGNAL PHASE CAN CLEAR TO WHICH HAS DEMAND
C-----FOR THE SIGNAL PHASE
      NPCLTO = NPHNXT(ICPHAS)
C;                  IF ( TIME . LT . TPRINT )    GO TO 107
C;    WRITE (6,707) ICPHAS,NPCLTO,(LPHNXT(I,ICPHAS),I=1,NPCLTO)
C;107 CONTINUE
C[    IF ( IPCLTO             .EQ.-2147483647   )STOP 'ACTSIG IPCLTO 01'
      DO 4020  I = IPCLTO , NPCLTO
      NEXTPH = LPHNXT(I,ICPHAS)
C-----IF THE SKIP PHASE SWITCH FOR THE NEXTPH SIGNAL PHASE IS OFF THEN
C-----THAT SIGNAL PHASE CAN NOT BE SKIPPED THUS GO TO 4030 AND USE THE
C-----NEXTPH SIGNAL PHASE
                    IF ( ISKP(NEXTPH).EQ.IOFF )  GO TO 4030
C-----CHECK THE DEMAND FOR THE NEXTPH SIGNAL PHASE USING BOTH THE
C-----POSITIVE AND NEGATIVE DETECTOR CONNECTIONS AND RETURN THE DEMAND
C-----FOR THE NEXTPH SIGNAL PHASE
      CALL  CHKDFP  ( IDFP,NEXTPH,2 )
C[    IDFPS      = .FALSE.
C-----IF THERE IS DEMAND FOR THE NEXTPH SIGNAL PHASE THEN GO TO 4030 AND
C-----USE THE NEXTPH SIGNAL PHASE
                    IF ( IDFP )                  GO TO 4030
 4020 CONTINUE
C-----IN THE ABSENCE OF DEMAND THE SIGNAL SHOULD GO TO THE LAST SIGNAL
C-----PHASE ON THE LIST OF SIGNAL PHASES THAT THIS SIGNAL PHASE CAN
C-----CLEAR TO
C[    IF ( NPCLTO             .EQ.-2147483647   )STOP 'ACTSIG NPCLTO 01'
      I = NPCLTO
C-----IF THIS SIGNAL PHASE IS THE MINOR SIGNAL PHASE FOR THE
C-----PARENT/MINOR CASE THEN USE THE LAST SIGNAL PHASE ELSE ERROR
            IF ( IMINOR(ICPHAS) . EQ . IYES )    GO TO 4030
      GO TO 9210
 4030 CONTINUE
                    IF ( IDUALL(ICPHAS).EQ.INO ) GO TO 4040
C-----THE CURRENT SIGNAL PHASE IS A DUAL LEFT SIGNAL PHASE THUS IF THE
C-----NEXT SIGNAL PHASE IS ONE OF THE SINGLE LEFT TURN SIGNAL PHASES
C-----THEN DO NOT RESET END OF MAX TO NOT SET (KEEP THE CLOCK RUNNING)
                    IF ( NEXTPH . EQ . ICPHAS+1 )GO TO 4050
                    IF ( NEXTPH . EQ . ICPHAS+2 )GO TO 4050
 4040 CONTINUE
C-----RESET THE END OF MAX TO NOT SET
      EOM(1) = TIMERR
 4050 CONTINUE
C-----BEGIN THE YELLOW CLEARANCE INTERVAL
      TR = TCI(ICPHAS)
C[    IF ( I                  .EQ.-2147483647   )STOP 'ACTSIG I      02'
      ICAMPC = ICAMPC + I
      INTER(1) = 2
C;                  IF ( TIME . LT . TPRINT )    GO TO 108
C;    WRITE (6,708) NGAPPH(ICPHAS),NMAXPH(ICPHAS),TCI(ICPHAS),
C;   *              TAR(ICPHAS),NEXTPH,I
C;108 CONTINUE
 5010 CONTINUE
C-----THE SIGNAL IS IN THE YELLOW CLEARANCE INTERVAL THUS IF THE TIME
C-----REMAINING IN THIS INTERVAL IS GT 0 THEN GO TO 7010 AND CLEAR
C-----TRAFFIC DETECTOR ACTUATIONS
                    IF ( TR . GT . 0.0D0 )       GO TO 7010
C-----BEGIN THE ALL-RED CLEARANCE INTERVAL
      TR = TAR(ICPHAS)
      ICAMPC = ICAMPS(ICPHAS) + NPHNXT(ICPHAS) + 1
      INTER(1) = 3
 6010 CONTINUE
C-----THE SIGNAL IS IN THE ALL-RED CLEARANCE INTERVAL THUS IF THE TIME
C-----REMAINING IN THIS INTERVAL IS GT 0 THEN GO TO 7010 AND CLEAR
C-----TRAFFIC DETECTOR ACTUATIONS
                    IF ( TR . GT . 0.0D0 )       GO TO 7010
C-----BEGIN THE GREEN INTERVAL ON THE NEW PHASE
      IPHASO = ICPHAS
      ICPHAS = NEXTPH
      ICAMPC = ICAMPS(NEXTPH)
      INTER(1) = 1
C4                  IF ( TIME . LT . TPRINT )    GO TO 109
C4    WRITE (6,709) ICAMPC,ICPHAS,IDUALL(ICPHAS),TII(ICPHAS),
C4   *              TVI(ICPHAS),TCI(ICPHAS),TAR(ICPHAS)
C4109 CONTINUE
C-----INITIALIZE THE DEMAND ON RED FOR THE NEW SIGNAL PHASE TO FALSE
      IDOR(1,1) = .FALSE.
C-----IF END OF MAX HAS BEEN RESET TO NOT SET THEN GO TO 6020 AND SET
C-----THE TIME INTO THE NEW SIGNAL PHASE TO ZERO AND THE TIME REMAINING
C-----IN THE NEW SIGNAL PHASE TO THE INITIAL INTERVAL PLUS THE VEHICLE
C-----INTERVAL FOR THE NEW SIGNAL PHASE
                    IF ( EOM(1) . EQ . TIMERR )  GO TO 6020
C-----THE NEW SIGNAL PHASE IS A SINGLE LEFT TURN SIGNAL PHASE FOLLOWING
C-----THE DUAL LEFT SIGNAL PHASE THUS RESET END OF MAX FOR THE MAXIMUM
C-----EXTENSION AFTER DEMAND ON RED FOR THE NEW SIGNAL PHASE (THE TIME
C-----INTO THE SIGNAL PHASE HAS CONTINUED TO BE UPDATED EACH DT DURING
C-----THE YELLOW CLEARANCE AND THE ALL-RED CLEARANCE INTERVAL)
C[    IF ( IPHASO             .EQ.-2147483647   )STOP 'ACTSIG IPHASO 01'
      EOM(1) = EOM(1) - TMX(IPHASO) + TMX(NEXTPH)
C-----IF THE MINIMUM ASSURED GREEN HAS BEEN SATISFIED THEN GO TO 1010
C-----AND CHECK THE GREEN INTERVAL FOR THE NEW SIGNAL PHASE (THE NEW
C-----SIGNAL PHASE MAY HAVE MAX-OUT OR GAP-OUT DURING THE YELLOW
C-----CLEARANCE OR THE ALL-RED CLEARANCE INTERVAL)
                    IF ( MAGSAT )                GO TO 1010
C-----SET THE TIME REMAINING FOR THE NEW SIGNAL PHASE AND SET THAT
C-----MINIMUM ASSURED GREEN HAS BEEN SATISFIED AND GO TO 1010 AND CHECK
C-----THE GREEN INTERVAL FOR THE NEW SIGNAL PHASE (THE NEW SIGNAL PHASE
C-----MAY HAVE MAX-OUT OR GAP-OUT DURING THE YELLOW CLEARANCE OR THE
C-----ALL-RED CLEARANCE INTERVAL)
      TR = TII(NEXTPH) + TVI(NEXTPH) - TP
      MAGSAT = .TRUE.
      GO TO 1010
 6020 CONTINUE
C-----SET THE TIME INTO THE NEW SIGNAL PHASE TO ZERO AND THE TIME
C-----REMAINING IN THE NEW SIGNAL PHASE TO THE INITIAL INTERVAL PLUS THE
C-----VEHICLE INTERVAL FOR THE NEW SIGNAL PHASE
      TP = 0.0D0
      TR = TII(NEXTPH) + TVI(NEXTPH)
C8    WRITE (IQD,601) ICPHAS,ICAMPC,(TIME+DT)
C+    WRITE (IDH,602) ICPHAS,ICAMPC,(TIME+DT)
 7010 CONTINUE
C-----CLEAR TRAFFIC DETECTOR ACTUATIONS
                    IF ( NLOOPS . LE . 0 )       GO TO 7030
      DO 7020  I = 1 , NLOOPS
      II=LLOOPS(I)
      LDCROS(II) = .FALSE.
      LDCLER(II) = .FALSE.
      VDCNT (II) = .FALSE.
 7020 CONTINUE
 7030 CONTINUE
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9210 CONTINUE
      CALL  ABORTR  ( 'STOP 921 - ' //
     *                'NO DEMAND FOR ANY PHASES ON LPHNXT LIST - ' //
     *                'ACTSIG'                                        )
      STOP  921
      END                                                               ACTSIG
C
C
C
      SUBROUTINE CHKDFP ( IDFP,IPHC,ITYPE )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      LOGICAL           IDFP,PHCALL,PHEXTD,NEMA
      INTEGER           ILD,IPHC,ITYPE,JLD,NUMLD
C;701 FORMAT(17H DEMAND FOR PHASE,I2,4H IS ,L1,
C;   *       23H DETECTOR CONNECTION = ,A3,8H NUMLD =,I3,6H LLD =,10I4)
C;702 FORMAT(17H DEMAND FOR PHASE,I2,4H IS ,L1)
C
C-----SUBROUTINE CHKDFP CHECKS THE DEMAND FOR THE IP SIGNAL PHASE
C-----(WHEN ITYPE IS EQ 1 THEN ONLY THE POSITIVE DETECTOR CONNECTIONS
C-----ARE CHECKED AND WHEN ITYPE IS EQ 2 THEN BOTH THE POSITIVE AND
C-----NEGATIVE CONNECTIONS ARE CHECKED)
C
C[    ILD        = -2147483647
C[    JLD        = -2147483647
C[    NUMLD      = -2147483647
C*    NRNAME = NRNAME + 1
C*    IRNAME(NRNAME) = 'CHKDFP'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C-----INITIALIZE SOME PARAMETERS FOR CHKDFP
      NEMA = ( ( ICONTR .EQ. ICNEMA ) .OR. ( ICONTR .EQ. ICNEMV ) )
      IF ( PEDS(IPHC) . AND . PDCALL(IPHC) )     THEN
C-----PEDESTRIAN CALL BUTTON PUSHED OR PED RECALL
        IDFP = .TRUE.
                                                 GO TO 3010
      END IF
      NUMLD = NLD(IPHC)
      IDFP = .TRUE.
C-----IF THE RECALL SWITCH IN ON THEN THERE IS DEMAND FOR THE IP SIGNAL
C-----PHASE THUS GO TO 3010 AND FINISH PROCESSING
                    IF ( IREC(IPHC) . EQ . ION ) GO TO 3010
C-----IF NO DETECTORS THEN THERE IS NO DEMAND FOR THE IP SIGNAL PHASE
C-----THUS GO TO 3010 AND FINISH PROCESSING
      IDFP = .FALSE.
                    IF ( NUMLD . EQ . 0 )        GO TO 3010
C-----INITIALIZE THE DEMAND FOR THE IP SIGNAL PHASE TO THE VALUE OF
C-----THE FIRST DETECTOR CONNECTED TO THE IP SIGNAL PHASE (THE FIRST
C-----DETECTOR CONNECTED TO ANY SIGNAL PHASE MUST BE POSITIVE)
      JLD = LLD(1,IPHC)
                    IF ( JLD . LT . 0 )          GO TO 1010
      IF (NLDF(IPHC) .GE. 1)                     THEN
C-----CALL AND EXTEND DETECTOR
        PHCALL = .TRUE.
        PHEXTD = .TRUE.
      ELSE
C-----EITHER CALL DETECTOR OR EXTEND DETECTOR
        PHCALL = (ILD .LE. NLDC(IPHC))
        PHEXTD = .NOT. PHCALL
      END IF
      IF (NEMA .AND. (PHCALL .OR. PHEXTD))       THEN
        IF ((IPHC .EQ. ICPHAT(IRING)) .AND.
     *      (INTER(IRING) .EQ. 1)          )     THEN
          IDFP = PHEXTD .AND. LDTRIP(JLD)
        ELSE
          IDFP = PHCALL .AND. LDTRIP(JLD)
        END IF
      ELSE
        IDFP = LDTRIP(JLD)
      END IF
      GO TO 1020
 1010 CONTINUE
                    IF ( ITYPE . EQ . 1 )        GO TO 3010
C[    IF ( JLD                .EQ.-2147483647   )STOP 'CHKDFP JLD    01'
      IDFP = (.NOT. LDTRIP(-JLD))
 1020 CONTINUE
C-----IF THERE WAS ONLY ONE DETECTOR CONNECTED TO THE IP SIGNAL PHASE
C-----THEN GO TO 3010 AND FINISH PROCESSING
                    IF ( NUMLD . LT . 2 )        GO TO 3010
C-----CHECK EACH DETECTOR CONNECTED TO THE IP SIGNAL PHASE (START AT THE
C-----SECOND DETECTOR FOR THE IP SIGNAL PHASE BECAUSE THE FIRST DETECTOR
C-----HAS BEEN USED TO INITIALIZE THE VALUE FOR IDFP)
      DO 2040  ILD = 2 , NUMLD
      JLD = LLD(ILD,IPHC)
      IF (NLDF(IPHC) .GE. ILD)                   THEN
C-----CALL AND EXTEND DETECTOR
        PHCALL = .TRUE.
        PHEXTD = .TRUE.
      ELSE
C-----EITHER CALL DETECTOR OR EXTEND DETECTOR
        PHCALL = (ILD .LE. (NLDC(IPHC) + NLDF(IPHC)))
        PHEXTD = .NOT. PHCALL
      END IF
C-----IF THE DETECTOR CONNECTION TYPE IS AND THEN GO TO 2020 AND PROCESS
C-----THE AND CONNECTIONS ELSE PROCESS THE OR CONNECTIONS
                    IF ( IANDOR(IPHC).EQ.JAND )  GO TO 2020
C-----IF THE DETECTOR IS A NEGATIVE CONNECTION THEN GO TO 2010 AND
C-----PROCESS THE NEGATIVE CONNECTION ELSE PROCESS THE POSITIVE
C-----CONNECTION
                    IF ( JLD . LT . 0 )          GO TO 2010
      IF (NEMA .AND. (PHCALL .OR. PHEXTD))       THEN
        IF ((IPHC .EQ. ICPHAT(IRING)) .AND.
     *      (INTER(IRING) .EQ. 1)          )     THEN
          IDFP = IDFP . OR . (PHEXTD .AND. LDTRIP(JLD))
        ELSE
          IDFP = IDFP . OR . (PHCALL .AND. LDTRIP(JLD))
        END IF
      ELSE
        IDFP = IDFP . OR . LDTRIP(JLD)
      END IF
      GO TO 2040
 2010 CONTINUE
C-----IF ONLY THE POSITIVE CONNECTIONS ARE TO BE CHECKED THEN GO TO 2040
C-----AND SKIP TO THE NEXT DETECTOR
                    IF ( ITYPE . EQ . 1 )        GO TO 2040
C[    IF ( JLD                .EQ.-2147483647   )STOP 'CHKDFP JLD    02'
      IDFP = IDFP . OR . (.NOT. LDTRIP(-JLD))
      GO TO 2040
 2020 CONTINUE
C-----PROCESS THE AND CONNECTION THUS IF THE DETECTOR IS A NEGATIVE
C-----CONNECTION THEN GO TO 2030 AND PROCESS THE NEGATIVE CONNECTION
C-----ELSE PROCESS THE POSITIVE CONNECTION
C[    IF ( JLD                .EQ.-2147483647   )STOP 'CHKDFP JLD    03'
                    IF ( JLD . LT . 0  )         GO TO 2030
      IDFP = IDFP . AND . LDTRIP(JLD)
      GO TO 2040
 2030 CONTINUE
C-----IF ONLY THE POSITIVE CONNECTIONS ARE TO BE CHECKED THEN GO TO 2040
C-----AND SKIP TO THE NEXT DETECTOR
                    IF ( ITYPE . EQ . 1 )        GO TO 2040
C[    IF ( JLD                .EQ.-2147483647   )STOP 'CHKDFP JLD    04'
      IDFP = IDFP . AND . (.NOT. LDTRIP(-JLD))
C-----END OF DETECTOR LOOP
 2040 CONTINUE
 3010 CONTINUE
C-----FINISH PROCESSING
C;                  IF ( TIME . LT . TPRINT )    GO TO 102
C;                  IF ( NUMLD . LE . 0 )        GO TO 101
C;    WRITE (6,701) IPHC,IDFP,IANDOR(IPHC),NUMLD,
C;   *              (LLD(ILD,IPHC),ILD=1,NUMLD)
C;    GO TO 102
C;101 CONTINUE
C;    WRITE (6,702) IPHC,IDFP
C;102 CONTINUE
      RETURN
      END                                                               CHKDFP
C
C
C
      SUBROUTINE SETLDF
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'USER'
      INTEGER           ILD,JLD,NUMLD
C;701 FORMAT(31H MEMORY FOR DETECTORS FOR PHASE,I2,10H SET FALSE)
C
C-----SUBROUTINE SETLDF SETS THE DETECTORS CONNECTED POSITIVE TO THE
C-----CURRENT SIGNAL PHASE TO FALSE
C
C[    ILD        = -2147483647
C[    JLD        = -2147483647
C[    NUMLD      = -2147483647
C*    NRNAME = NRNAME + 1
C*    IRNAME(NRNAME) = 'SETLDF'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
      NUMLD = NLD(ICPHAS)
C-----IF THERE ARE NO DETECTORS CONNECTED TO THE CURRENT SIGNAL PHASE
C-----THEN RETURN
                    IF ( NUMLD . LT . 1 )        RETURN
C-----CHECK EACH DETECTOR CONNECTED TO THE CURRENT SIGNAL PHASE
      DO 1010  ILD = 1 , NUMLD
      JLD = LLD(ILD,ICPHAS)
C-----IF DETECTOR JLD IS NOT CONNECTED POSITIVE TO THE CURRENT SIGNAL
C-----PHASE THEN GO TO 1010 AND SKIP TO THE NEXT DETECTOR ELSE SET
C-----DETECTOR JLD TO FALSE
                    IF ( JLD . LT . 0 )          GO TO 1010
      LDTRIP(JLD) = .FALSE.
 1010 CONTINUE
C;                  IF ( TIME . LT . TPRINT )    GO TO 101
C;    WRITE (6,701) ICPHAS
C;101 CONTINUE
      RETURN
      END                                                               SETLDF
C
C
C
      SUBROUTINE TX3467
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C-----OPTIONS
      INTEGER           D03P37,D05P25,D13P37,D56P25,F6OPTA,F6OPTB,
     *                  F6OPTC,F7OPTA,F7OPTB,F7OPTC,TLP27H,TLP27O
      PARAMETER       ( D03P37 =  1 )
      PARAMETER       ( D05P25 =  3 )
      PARAMETER       ( D13P37 =  2 )
      PARAMETER       ( D56P25 =  4 )
      PARAMETER       ( F6OPTA =  7 )
      PARAMETER       ( F6OPTB =  8 )
      PARAMETER       ( F6OPTC =  9 )
      PARAMETER       ( F7OPTA = 10 )
      PARAMETER       ( F7OPTB = 11 )
      PARAMETER       ( F7OPTC = 12 )
      PARAMETER       ( TLP27H =  5 )
      PARAMETER       ( TLP27O =  6 )
C-----TIMERS
      INTEGER           F3P35G,F4P35G,F6P16H,F6P16L,F6P27G,F7P16H,
     *                  F7P16L,F7P27G,P17AG ,P26AG ,P2TG  ,P7TG
      PARAMETER       ( F3P35G = 12 )
      PARAMETER       ( F4P35G =  1 )
      PARAMETER       ( F6P16H =  7 )
      PARAMETER       ( F6P16L =  6 )
      PARAMETER       ( F6P27G =  8 )
      PARAMETER       ( F7P16H = 10 )
      PARAMETER       ( F7P16L =  9 )
      PARAMETER       ( F7P27G = 11 )
      PARAMETER       ( P17AG  =  2 )
      PARAMETER       ( P26AG  =  3 )
      PARAMETER       ( P2TG   =  4 )
      PARAMETER       ( P7TG   =  5 )
C-----PHASE COMBINATIONS
      INTEGER           PC15,PC16,PC17,PC25,PC26,PC27,PC35,PC36,PC37
      PARAMETER       ( PC15   =  1 )
      PARAMETER       ( PC16   =  2 )
      PARAMETER       ( PC17   =  3 )
      PARAMETER       ( PC25   =  4 )
      PARAMETER       ( PC26   =  5 )
      PARAMETER       ( PC27   =  6 )
      PARAMETER       ( PC35   =  7 )
      PARAMETER       ( PC36   =  8 )
      PARAMETER       ( PC37   =  9 )
C-----STATE COMBINATIONS
      INTEGER           PC1536,PC1737,PC2526
      PARAMETER       ( PC1536 =  1 )
      PARAMETER       ( PC1737 =  2 )
      PARAMETER       ( PC2526 =  8 )
C-----MISCELANEOUS
      LOGICAL           DEMAND,DFP(NPH),NEWCSP,NEWPH(NRG),SIMGAP
C[    LOGICAL           DFPS(NPH),NEWPHS(NRG)
C[    LOGICAL           DEMANS,NEWCSS,SIMGAS
      INTEGER           I,ICPCOM,II,INCPCT,IPCLTO,IPST,IT1,IT2,
     *                  J,JRING,LD1,LD13,LD2,LD2A,LD3,LD5,LD56,LD6,LD7,
     *                  LD7A,NPCLTO
      EQUIVALENCE       (LLOOPS( 1),LD1 ),(LLOOPS( 2),LD2 )
      EQUIVALENCE       (LLOOPS( 3),LD2A),(LLOOPS( 4),LD3 )
      EQUIVALENCE       (LLOOPS( 5),LD13),(LLOOPS( 6),LD5 )
      EQUIVALENCE       (LLOOPS( 7),LD56),(LLOOPS( 8),LD6 )
      EQUIVALENCE       (LLOOPS( 9),LD7 ),(LLOOPS(10),LD7A)
C
C-----                  USAGE OF SPECIAL TIMERS
C----- NUM  VARIABLE    FIGURES             DESCRIPTION
C----- ---  --------  ----------  -------------------------------
C-----  01  F4P35G       4  6  7  PHASE 3-5 CLEARANCE GREEN
C-----  02  P17AG     3  4  6  7  PHASE 1-7 ADVANCE GREEN
C-----  03  P26AG     3  4  6  7  PHASE 2-6 ADVANCE GREEN
C-----  04  P2TG         4  6  7  PHASE  2  TRANSFER GAP
C-----  05  P7TG         4  6  7  PHASE  7  TRANSFER GAP
C-----  06  F6P16L          6     PHASE 1-6 ADVANCE GREEN MINIMUM
C-----  07  F6P16H          6     PHASE 1-6 ADVANCE GREEN MAXIMUM
C-----  08  F6P27G          6     PHASE 2-7 ADVANCE GREEN
C-----  09  F7P16L             7  PHASE 1-6 ADVANCE GREEN MINIMUM
C-----  10  F7P16H             7  PHASE 1-6 ADVANCE GREEN MAXIMUM
C-----  11  F7P27G             7  PHASE 2-7 ADVANCE GREEN
C-----  12  F3P35G    3           PHASE 3-5 CLEARANCE GREEN
C
C[    DO  I = 1 , NPH
C[    DFPS  (I)  = .TRUE.
C[    END DO
C[    DO  I = 1 , NRG
C[    NEWPHS(I)  = .TRUE.
C[    END DO
C[    DEMANS     = .TRUE.
C[    NEWCSS     = .TRUE.
C[    SIMGAS     = .TRUE.
C[    I          = -2147483647
C[    ICPCOM     = -2147483647
C[    II         = -2147483647
C[    INCPCT     = -2147483647
C[    IPCLTO     = -2147483647
C[    IPST       = -2147483647
C[    IRING      = -2147483647
C[    IT1        = -2147483647
C[    IT2        = -2147483647
C[    J          = -2147483647
C[    JRING      = -2147483647
C[    NPCLTO     = -2147483647
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'TX3467'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C-----START OF CODE FOR TESTING - FIRST TIME ONLY CODE
      IF(FIRSIG)THEN
        FIRSIG=.FALSE.
        CALL TX3DS1
        LLD(1,1)=LD1
        NLD(1)=1
        IANDOR(1)='OR'
        LLD(1,2)=LD2
        LLD(2,2)=LD2A
        NLD(2)=2
        IANDOR(2)='OR'
        LLD(1,3)=LD3
        LLD(2,3)=LD13
        NLD(3)=2
        IANDOR(3)='OR'
        LLD(1,5)=LD5
        LLD(2,5)=LD56
        NLD(5)=2
        IANDOR(5)='OR'
        LLD(1,6)=LD6
        NLD(6)=1
        IANDOR(6)='OR'
        LLD(1,7)=LD7
        LLD(2,7)=LD7A
        NLD(7)=2
        IANDOR(7)='OR'
        IFPR(1)=1
        ILPR(1)=3
        IFPR(2)=5
        ILPR(2)=7
        REST(PC15)=.TRUE.
        REST(PC25)=.TRUE.
        REST(PC36)=.TRUE.
        REST(PC37)=.TRUE.
C
C-----INITIALIZATION FOR ALL FIGURES (START)
C
C
C-----FIGURE 3 INITIALIZATION (START)
C
        IF(FIG3)THEN
C=        CALL DINCH('FIGURE 3',15,IRRING,67,IPGZ)
C-----FIGURE 3 NOTE 3.A
          ICPC=PC16
          LPHASE(1)=1
          LPHNXT(1,1)=3
          NPHNXT(1)=1
          LPHASE(2)=2
          LPHNXT(1,2)=1
          LPHNXT(2,2)=3
          NPHNXT(2)=2
          LPHASE(3)=3
          LPHNXT(1,3)=2
          LPHNXT(2,3)=1
          NPHNXT(3)=2
          LPHASE(4)=5
          LPHNXT(1,5)=7
          LPHNXT(2,5)=6
          NPHNXT(5)=2
          LPHASE(5)=6
          LPHNXT(1,6)=5
          NPHNXT(6)=1
          LPHASE(6)=7
          LPHNXT(1,7)=6
          LPHNXT(2,7)=5
          NPHNXT(7)=2
C-----FIGURE 3 NOTE 1 D13
          NLD(3)=1
C-----FIGURE 3 NOTE 1 D56
          NLD(5)=1
C=        STANAM(1)='PC1536'
C=        STANAM(2)='PC1737'
C=        STANAM(3)=' PC17 '
C=        STANAM(4)=' PC25 '
C=        STANAM(5)=' PC26 '
C=        STANAM(6)=' PC27 '
C=        STANAM(7)=' PC35 '
C=        STANAM(8)='PC2526'
C=        STANAM(9)=' PC37 '
          GO TO 5
        END IF
C
C-----FIGURE 3 INITIALIZATION (END)
C
C
C-----FIGURE 4 INITIALIZATION (START)
C
        IF(FIG4)THEN
C=        CALL DINCH('FIGURE 4',15,IRRING,67,IPGZ)
C-----FIGURE 4 NOTE 1
          IPS(1,PC15)=PC15
          IPS(2,PC15)=PC25
          IPS(3,PC15)=PC36
          IPS(4,PC15)=PC37
          NPS(PC15)=4
          IPS(1,PC25)=PC25
          IPS(2,PC25)=PC36
          IPS(3,PC25)=PC37
          IPS(4,PC25)=PC15
          NPS(PC25)=4
          IPS(1,PC36)=PC36
          IPS(2,PC36)=PC37
          IPS(3,PC36)=PC15
          IPS(4,PC36)=PC25
          NPS(PC36)=4
          IPS(1,PC37)=PC37
          IPS(2,PC37)=PC15
          IPS(3,PC37)=PC25
          IPS(4,PC37)=PC36
          NPS(PC37)=4
          IPC(PC15,PC36)=PC35
          IPC(PC15,PC37)=PC35
          IPC(PC25,PC36)=PC26
          IPC(PC25,PC37)=PC35
          IPC(PC36,PC15)=PC35
          IPC(PC36,PC25)=PC35
          IPC(PC37,PC15)=PC17
          IPC(PC37,PC25)=PC35
          ICPC=PC15
C-----FIGURE 4 NOTE 2 D2 & D2A
          NLD(2)=1
C-----FIGURE 4 NOTE 2 D7 & D7A
          NLD(7)=1
          GO TO 5
        END IF
C
C-----FIGURE 4 INITIALIZATION (END)
C
C
C-----FIGURE 6 INITIALIZATION (START)
C
        IF(FIG6)THEN
C=        CALL DINCH('FIGURE 6',15,IRRING,67,IPGZ)
          IPS(1,PC15)=PC15
          IPS(2,PC15)=PC25
          IPS(3,PC15)=PC37
          IPS(4,PC15)=PC36
          NPS(PC15)=4
          IPS(1,PC25)=PC25
          IPS(2,PC25)=PC27
          IPS(3,PC25)=PC36
          IPS(4,PC25)=PC15
          NPS(PC25)=4
          IPS(1,PC27)=PC27
          IPS(2,PC27)=PC37
          NPS(PC27)=2
          IPS(1,PC37)=PC37
          IPS(2,PC37)=PC36
          IPS(3,PC37)=PC15
          IPS(4,PC37)=PC25
          NPS(PC37)=4
          IPS(1,PC36)=PC36
C-----FIGURE 6 NOTE 3 OPTION A = OFF
          IF((TMRSET(F6P16L).EQ.0.0D0) .AND. (.NOT. OPTN(F6OPTA)))THEN
            IPS(2,PC36)=PC15
          ELSE
            IPS(2,PC36)=PC16
          END IF
          IPS(3,PC36)=PC25
          IPS(4,PC36)=PC37
          NPS(PC36)=4
          IPS(1,PC16)=PC16
          IPS(2,PC16)=PC15
          NPS(PC16)=2
          IPC(PC15,PC36)=PC35
          IPC(PC15,PC37)=PC35
          IPC(PC25,PC36)=PC26
          IPC(PC25,PC37)=PC35
          IPC(PC36,PC25)=PC35
C-----FIGURE 6 NOTE 3 OPTION A = ON
          IF(OPTN(F6OPTA))REST(PC16)=.TRUE.
          IF(OPTN(F6OPTC))THEN
C-----FIGURE 6 NOTE 3 OPTION C = ON
            IPC(PC37,PC15)=PC17
          ELSE
C-----FIGURE 6 NOTE 3 OPTION C = OFF
            IPC(PC37,PC15)=PC35
          END IF
          IPC(PC37,PC25)=PC35
          ICPC=PC15
C-----FIGURE 6 NOTE 4 D2 & D2A
          NLD(2)=1
C-----FIGURE 6 NOTE 4 D7 & D7A
          NLD(7)=1
          GO TO 5
        END IF
C
C-----FIGURE 6 INITIALIZATION (END)
C
C
C-----FIGURE 7 INITIALIZATION (START)
C
        IF(FIG7)THEN
C=        CALL DINCH('FIGURE 7',15,IRRING,67,IPGZ)
          IPS(1,PC15)=PC15
C-----FIGURE 7 NOTE 3 OPTION A = OFF
          IF((TMRSET(F7P16L).EQ.0.0D0) .AND. (.NOT. OPTN(F7OPTA)))THEN
            IPS(2,PC15)=PC36
          ELSE
            IPS(2,PC15)=PC16
          END IF
          IPS(3,PC15)=PC37
          IPS(4,PC15)=PC25
          NPS(PC15)=4
          IPS(1,PC16)=PC16
          IPS(2,PC16)=PC36
          NPS(PC16)=2
          IPS(1,PC36)=PC36
          IPS(2,PC36)=PC37
          IPS(3,PC36)=PC25
          IPS(4,PC36)=PC15
          NPS(PC36)=4
          IPS(1,PC37)=PC37
          IPS(2,PC37)=PC27
          IPS(3,PC37)=PC15
          IPS(4,PC37)=PC36
          NPS(PC37)=4
          IPS(1,PC27)=PC27
          IPS(2,PC27)=PC25
          NPS(PC27)=2
          IPS(1,PC25)=PC25
          IPS(2,PC25)=PC15
          IPS(3,PC25)=PC36
          IPS(4,PC25)=PC37
          NPS(PC25)=4
          IPC(PC36,PC25)=PC35
          IPC(PC36,PC15)=PC35
          IF(OPTN(F7OPTC))THEN
C-----FIGURE 7 NOTE 3 OPTION C = ON
            IPC(PC25,PC36)=PC26
          ELSE
C-----FIGURE 7 NOTE 3 OPTION C = OFF
            IPC(PC25,PC36)=PC35
          END IF
          IPC(PC37,PC15)=PC17
          IPC(PC25,PC37)=PC35
          IPC(PC15,PC37)=PC35
C-----FIGURE 7 NOTE 3 OPTION A = ON
          IF(OPTN(F7OPTA))REST(PC16)=.TRUE.
          ICPC=PC15
C-----FIGURE 7 NOTE 4 D2 & D2A
          NLD(2)=1
C-----FIGURE 7 NOTE 4 D7 & D7A
          NLD(7)=1
          GO TO 5
        END IF
C
C-----FIGURE 7 INITIALIZATION (END)
C
        GO TO 9280
    5   CONTINUE
        DO 6 I=1,NRING
        J=IPH(ICPC,I)
        CPH(J)=.TRUE.
        ICAMCT(I)=ICAMPS(J)
        ICPHAT(I)=J
        INTER(I)=1
        NEXTTT(I)=0
        TPT(I)=0.0D0
        TRT(I)=TMI(J)
    6   CONTINUE
        CALL MAKECS(ICAMCT(1),ICAMCT(2),ICAMPC)
        CALL OVLP
C
C-----INITIALIZATION FOR ALL FIGURES (END)
C
        CALL TX3DS2
        GO TO 7010
      END IF
C-----END OF CODE FOR TESTING - FIRST TIME ONLY CODE
      CALL TX3DS3
C
C-----PROCESS MULTIPLE RING SIGNAL (START)
C
      NEWCSP=.FALSE.
C[    NEWCSS     = .FALSE.
      SIMGAP=.FALSE.
C[    SIMGAS     = .FALSE.
      ICAMPO=ICAMPC
      DO 20 IRING=1,NRING
      TPT(IRING) = TPT(IRING) + DT
      TRT(IRING) = TRT(IRING) - DT
                    IF ( TRT(IRING).LT.0.5D0*DT )TRT(IRING) = 0.0D0
      NEWPH(IRING)=.FALSE.
C[    NEWPHS(IRING) = .FALSE.
      NEXTTT(IRING)=0
   20 CONTINUE
C
C-----CHECK DEMAND FOR PHASE FOR ALL FIGURES (START)
C
C-----DEMAND IS SYSTEM-WIDE DEMAND ON RED
      DEMAND=.FALSE.
C[    DEMANS     = .FALSE.
      DO 710 IRING=1,NRING
      ICPHAS=ICPHAT(IRING)
      DO 700 I=IFPR(IRING),ILPR(IRING)
      IF(CLPH(I))THEN
        DEMAND=.TRUE.
C[      DEMANS   = .FALSE.
      END IF
      CALL CHKDFP (DFP(I),I,1)
C[    DFPS(I)    = .FALSE.
      IF(.NOT. DFP(I))                           GO TO  700
      IF((I.EQ.ICPHAS) .AND. (INTER(IRING).EQ.1))GO TO  700
      CLPH(I)=.TRUE.
      DEMAND=.TRUE.
C[    DEMANS     = .FALSE.
      IF(FIG3)THEN
C-----FIGURE 3 NOTE 3.B
        IF((I.EQ.2) .OR. (I.EQ.7))THEN
          IF(STATE(PC1536) .OR. (CPH(1).AND.CPH(6)))THEN
            CLPH(3)=.TRUE.
            CLPH(5)=.TRUE.
          END IF
        END IF
C-----FIGURE 3 NOTE 3.D (DURING 2-7)
        IF((I.EQ.1) .OR. (I.EQ.6))THEN
          IF(CPH(2).AND.CPH(7))THEN
            IF(I.EQ.1)THEN
              CLPH(6)=.TRUE.
            END IF
            IF(I.EQ.6)THEN
              CLPH(1)=.TRUE.
            END IF
          END IF
        END IF
      END IF
      IF(FIG4)THEN
C-----FIGURE 4
        IF((I.EQ.1) .OR. (I.EQ.2))THEN
          IF(CPH(3) .AND. CPH(7))THEN
            CLPH(5)=.TRUE.
          END IF
        END IF
C-----FIGURE 4
        IF((I.EQ.6) .OR. (I.EQ.7))THEN
          IF(CPH(2).AND.CPH(5))THEN
            CLPH(3)=.TRUE.
          END IF
        END IF
      END IF
      IF(FIG6)THEN
C-----FIGURE 6
        IF(CPH(3) .AND. CPH(6))THEN
          IF(OPTN(F6OPTA))THEN
            IF(I.EQ.2)THEN
              CLPH(5)=.TRUE.
            END IF
          ELSE
            IF((I.EQ.1) .OR. (I.EQ.2))THEN
              CLPH(5)=.TRUE.
            END IF
          END IF
        END IF
C-----FIGURE 6
        IF(CPH(2).AND.CPH(5))THEN
          IF(OPTN(F6OPTB))THEN
            IF(I.EQ.6)THEN
              CLPH(3)=.TRUE.
            END IF
          ELSE
            IF((I.EQ.6) .OR. (I.EQ.7))THEN
              CLPH(3)=.TRUE.
            END IF
          END IF
        END IF
      END IF
      IF(FIG7)THEN
C-----FIGURE 7
        IF(CPH(3) .AND. CPH(7))THEN
          IF(OPTN(F7OPTB))THEN
            IF(I.EQ.1)THEN
              CLPH(5)=.TRUE.
            END IF
          ELSE
            IF((I.EQ.1) .OR. (I.EQ.2))THEN
              CLPH(5)=.TRUE.
            END IF
          END IF
        END IF
C-----FIGURE 7
        IF(CPH(1).AND.CPH(5))THEN
          IF(OPTN(F7OPTA))THEN
            IF(I.EQ.7)THEN
              CLPH(3)=.TRUE.
            END IF
          ELSE
            IF((I.EQ.6) .OR. (I.EQ.7))THEN
              CLPH(3)=.TRUE.
            END IF
          END IF
        END IF
      END IF
  700 CONTINUE
  710 CONTINUE
C
C-----CHECK DEMAND FOR PHASE FOR ALL FIGURES (END)
C
C
C-----PROCESS SPECIAL TIMERS FOR ALL FIGURES (START)
C
C
C-----FIGURE 3 PROCESS SPECIAL TIMERS (START)
C
      IF(FIG3)THEN
C-----FIGURE 3 DIAMOND OPERATION NOTE 2 INTERVAL 2 (END)
        IF(TMRVAL(P17AG) .GT. 0.0D0)THEN
          TMRVAL(P17AG)=TMRVAL(P17AG)-DT
          IF(TMRVAL(P17AG) .LE. 0.0D0)THEN
            TMRVAL(P17AG)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC17)=.FALSE.
            IF(CLPH(3) .AND. (.NOT. CLPH(6)))THEN
              SEL(1)=.TRUE.
              GMT(1)='T'
            ELSE
              SEL(7)=.TRUE.
              GMT(7)='T'
              CLPH(6)=.TRUE.
            END IF
          END IF
        END IF
C-----FIGURE 3 DIAMOND OPERATION NOTE 2 INTERVAL 3 (END)
        IF(TMRVAL(P26AG) .GT. 0.0D0)THEN
          TMRVAL(P26AG)=TMRVAL(P26AG)-DT
          IF(TMRVAL(P26AG) .LE. 0.0D0)THEN
            TMRVAL(P26AG)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(6)=.FALSE.
            STATE(PC26)=.FALSE.
            IF(CLPH(5) .AND. (.NOT. CLPH(1)))THEN
              SEL(6)=.TRUE.
              GMT(6)='T'
            ELSE
              SEL(2)=.TRUE.
              GMT(2)='T'
              CLPH(1)=.TRUE.
            END IF
          END IF
        END IF
C-----FIGURE 3 NOTE 3.C (END)
        IF(STATE(PC27))THEN
          IF((TPT(1).GE.TMI(2)) .AND. (TPT(2).GE.TMI(7)))THEN
            HOLD(2)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC27)=.FALSE.
          END IF
        END IF
C-----FIGURE 3 NOTE 3.E (END)
        IF(TMRVAL(F3P35G) .GT. 0.0D0)THEN
          TMRVAL(F3P35G)=TMRVAL(F3P35G)-DT
          IF(TMRVAL(F3P35G) .LE. 0.0D0)THEN
            TMRVAL(F3P35G)=0.0D0
            HOLD(3)=.FALSE.
            HOLD(5)=.FALSE.
            STATE(PC35)=.FALSE.
          END IF
        END IF
      END IF
C
C-----FIGURE 3 PROCESS SPECIAL TIMERS (END)
C
C
C-----FIGURE 4 PROCESS SPECIAL TIMERS (START)
C
      IF(FIG4)THEN
C-----FIGURE 4 DIAMOND OPERATION NOTE 2 INTERVAL 2 (END)
        IF(TMRVAL(P17AG) .GT. 0.0D0)THEN
          TMRVAL(P17AG)=TMRVAL(P17AG)-DT
          IF(TMRVAL(P17AG) .LE. 0.0D0)THEN
            TMRVAL(P17AG)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC17)=.FALSE.
            SEL(7)=.TRUE.
            GMT(7)='T'
          END IF
        END IF
C-----FIGURE 4 DIAMOND OPERATION NOTE 2 INTERVAL 3 (END)
        IF(TMRVAL(P26AG) .GT. 0.0D0)THEN
          TMRVAL(P26AG)=TMRVAL(P26AG)-DT
          IF(TMRVAL(P26AG) .LE. 0.0D0)THEN
            TMRVAL(P26AG)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(6)=.FALSE.
            STATE(PC26)=.FALSE.
            SEL(2)=.TRUE.
            GMT(2)='T'
          END IF
        END IF
C-----FIGURE 4 NOTE 1 PHASE 3-5 CLEARANCE GREEN TIMER (END)
        IF(STATE(PC35))THEN
          TMRVAL(F4P35G)=TMRVAL(F4P35G)-DT
          IF(TMRVAL(F4P35G) .LE. 0.0D0)THEN
            TMRVAL(F4P35G)=0.0D0
            HOLD(3)=.FALSE.
            HOLD(5)=.FALSE.
            STATE(PC35)=.FALSE.
            IF(IPH(INPC,1) .EQ. 3)THEN
              SEL(5)=.TRUE.
              GMT(5)='T'
            ELSE
              SEL(3)=.TRUE.
              GMT(3)='T'
            END IF
          END IF
        END IF
C-----FIGURE 4 NOTE 2 D2 & D2A (END)
        IF(TMRVAL(P2TG).GT.0.0D0)THEN
          TMRVAL(P2TG)=TMRVAL(P2TG)-DT
          IF(TMRVAL(P2TG) .LE. 0.0D0)THEN
            TMRVAL(P2TG)=0.0D0
            LLD(1,2)=LD2A
C=          CALL LDCSH(2,IRPHAS,ICLD)
          END IF
        END IF
C-----FIGURE 4 NOTE 2 D7 & D7A (END)
        IF(TMRVAL(P7TG).GT.0.0D0)THEN
          TMRVAL(P7TG)=TMRVAL(P7TG)-DT
          IF(TMRVAL(P7TG) .LE. 0.0D0)THEN
            TMRVAL(P7TG)=0.0D0
            LLD(1,7)=LD7A
C=          CALL LDCSH(7,IRPHAS,ICLD)
          END IF
        END IF
      END IF
C
C-----FIGURE 4 PROCESS SPECIAL TIMERS (END)
C
C
C-----FIGURE 6 PROCESS SPECIAL TIMERS (START)
C
      IF(FIG6)THEN
C-----FIGURE 6 NOTE 3 OPTION A = OFF MINIMUM (END)
        IF(TMRVAL(F6P16L) .GT. 0.0D0)THEN
          TMRVAL(F6P16L)=TMRVAL(F6P16L)-DT
          IF(TMRVAL(F6P16L) .LE. 0.0D0)THEN
            TMRVAL(F6P16L)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(6)=.FALSE.
          END IF
        END IF
C-----FIGURE 6 NOTE 3 OPTION A = OFF MAXIMUM (END)
        IF(TMRVAL(F6P16H) .GT. 0.0D0)THEN
          TMRVAL(F6P16H)=TMRVAL(F6P16H)-DT
          IF(TMRVAL(F6P16H) .LE. 0.0D0)THEN
            TMRVAL(F6P16H)=0.0D0
            STATE(PC16)=.FALSE.
            SEL(6)=.TRUE.
            GMT(6)='T'
          END IF
        END IF
C-----FIGURE 6 NOTE 3 OPTION C = ON (END)
        IF(TMRVAL(P17AG) .GT. 0.0D0)THEN
          TMRVAL(P17AG)=TMRVAL(P17AG)-DT
          IF(TMRVAL(P17AG) .LE. 0.0D0)THEN
            TMRVAL(P17AG)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC17)=.FALSE.
            SEL(7)=.TRUE.
            GMT(7)='T'
          END IF
        END IF
C-----FIGURE 6 PHASE 2-6 ADVANCE GREEN TIMER (END)
        IF(TMRVAL(P26AG) .GT. 0.0D0)THEN
          TMRVAL(P26AG)=TMRVAL(P26AG)-DT
          IF(TMRVAL(P26AG) .LE. 0.0D0)THEN
            TMRVAL(P26AG)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(6)=.FALSE.
            STATE(PC26)=.FALSE.
            SEL(2)=.TRUE.
            GMT(2)='T'
          END IF
        END IF
C-----FIGURE 6 NOTE 3 OPTION B = OFF (END)
        IF(STATE(PC27))THEN
          TMRVAL(F6P27G)=TMRVAL(F6P27G)-DT
          IF(TMRVAL(F6P27G) .LE. 0.0D0)THEN
            TMRVAL(F6P27G)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC27)=.FALSE.
            SEL(2)=.TRUE.
            GMT(2)='T'
          END IF
        END IF
C-----FIGURE 6 NOTE 3 OPTION C = OFF (END)
        IF(TMRVAL(F4P35G) .GT. 0.0D0)THEN
          TMRVAL(F4P35G)=TMRVAL(F4P35G)-DT
          IF(TMRVAL(F4P35G) .LE. 0.0D0)THEN
            TMRVAL(F4P35G)=0.0D0
            HOLD(3)=.FALSE.
            HOLD(5)=.FALSE.
            STATE(PC35)=.FALSE.
            IF(INPC .NE. PC15)THEN
              IF(IPH(INPC,1) .EQ. 3)THEN
                SEL(5)=.TRUE.
                GMT(5)='T'
              ELSE
                SEL(3)=.TRUE.
                GMT(3)='T'
              END IF
            END IF
          END IF
        END IF
C-----FIGURE 6 NOTE 4 D2A (RESET)
        IF(CPH(2).AND.CPH(5).AND.LDTRIP(LD2))THEN
          IF(TMRVAL(P2TG) .GT. 0.0D0)TMRVAL(P2TG)=TMRSET(P2TG)+DT
        END IF
C-----FIGURE 6 NOTE 4 D2A (END)
        IF(TMRVAL(P2TG).GT.0.0D0)THEN
          TMRVAL(P2TG)=TMRVAL(P2TG)-DT
          IF(TMRVAL(P2TG) .LE. 0.0D0)THEN
            TMRVAL(P2TG)=0.0D0
            IF(OPTN(F6OPTB))THEN
              LLD(1,2)=LD2A
C=            CALL LDCSH(2,IRPHAS,ICLD)
            ELSE
              LLD(1,5)=LD2A
              NLD(5)=1
C=            CALL LDCSH(5,IRPHAS,ICLD)
            END IF
          END IF
        END IF
C-----FIGURE 6 NOTE 4 D7A (RESET)
        IF(CPH(3).AND.CPH(7).AND.OPTN(F6OPTC))THEN
          IF(CLPH(6))THEN
            TMRVAL(P7TG)=0.0D0
            LLD(1,7)=LD7
C=          CALL LDCSH(7,IRPHAS,ICLD)
          ELSE
            IF(LDTRIP(LD7))THEN
              IF(TMRVAL(P7TG) .GT. 0.0D0)TMRVAL(P7TG)=TMRSET(P7TG)+DT
            END IF
          END IF
        END IF
C-----FIGURE 6 NOTE 4 D7A (END)
        IF(TMRVAL(P7TG).GT.0.0D0)THEN
          TMRVAL(P7TG)=TMRVAL(P7TG)-DT
          IF(TMRVAL(P7TG) .LE. 0.0D0)THEN
            TMRVAL(P7TG)=0.0D0
            LLD(1,7)=LD7A
C=          CALL LDCSH(7,IRPHAS,ICLD)
          END IF
        END IF
      END IF
C
C-----FIGURE 6 PROCESS SPECIAL TIMERS (END)
C
C
C-----FIGURE 7 PROCESS SPECIAL TIMERS (START)
C
      IF(FIG7)THEN
C-----FIGURE 7 NOTE 3 OPTION A = OFF MINIMUM (END)
        IF(TMRVAL(F7P16L) .GT. 0.0D0)THEN
          TMRVAL(F7P16L)=TMRVAL(F7P16L)-DT
          IF(TMRVAL(F7P16L) .LE. 0.0D0)THEN
            TMRVAL(F7P16L)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(6)=.FALSE.
          END IF
        END IF
C-----FIGURE 7 NOTE 3 OPTION A = OFF MAXIMUM (END)
        IF(TMRVAL(F7P16H) .GT. 0.0D0)THEN
          TMRVAL(F7P16H)=TMRVAL(F7P16H)-DT
          IF(TMRVAL(F7P16H) .LE. 0.0D0)THEN
            TMRVAL(F7P16H)=0.0D0
            STATE(PC16)=.FALSE.
            SEL(1)=.TRUE.
            GMT(1)='T'
          END IF
        END IF
C-----FIGURE 7 PHASE 1-7 ADVANCE GREEN TIMER (END)
        IF(TMRVAL(P17AG) .GT. 0.0D0)THEN
          TMRVAL(P17AG)=TMRVAL(P17AG)-DT
          IF(TMRVAL(P17AG) .LE. 0.0D0)THEN
            TMRVAL(P17AG)=0.0D0
            HOLD(1)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC17)=.FALSE.
            SEL(7)=.TRUE.
            GMT(7)='T'
          END IF
        END IF
C-----FIGURE 7 NOTE 3 OPTION C = ON (END)
        IF(TMRVAL(P26AG) .GT. 0.0D0)THEN
          TMRVAL(P26AG)=TMRVAL(P26AG)-DT
          IF(TMRVAL(P26AG) .LE. 0.0D0)THEN
            TMRVAL(P26AG)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(6)=.FALSE.
            STATE(PC26)=.FALSE.
            SEL(2)=.TRUE.
            GMT(2)='T'
          END IF
        END IF
C-----FIGURE 7 NOTE 3 OPTION B = OFF (END)
        IF(STATE(PC27))THEN
          TMRVAL(F7P27G)=TMRVAL(F7P27G)-DT
          IF(TMRVAL(F7P27G) .LE. 0.0D0)THEN
            TMRVAL(F7P27G)=0.0D0
            HOLD(2)=.FALSE.
            HOLD(7)=.FALSE.
            STATE(PC27)=.FALSE.
            SEL(7)=.TRUE.
            GMT(7)='T'
          END IF
        END IF
C-----FIGURE 7 NOTE 3 OPTION C = OFF (END)
        IF(TMRVAL(F4P35G) .GT. 0.0D0)THEN
          TMRVAL(F4P35G)=TMRVAL(F4P35G)-DT
          IF(TMRVAL(F4P35G) .LE. 0.0D0)THEN
            TMRVAL(F4P35G)=0.0D0
            HOLD(3)=.FALSE.
            HOLD(5)=.FALSE.
            STATE(PC35)=.FALSE.
            IF(INPC .NE. PC36)THEN
              IF(IPH(INPC,1) .EQ. 3)THEN
                SEL(5)=.TRUE.
                GMT(5)='T'
              ELSE
                SEL(3)=.TRUE.
                GMT(3)='T'
              END IF
            END IF
          END IF
        END IF
C-----FIGURE 7 NOTE 4 D2A (RESET)
        IF(CPH(2).AND.CPH(5).AND.OPTN(F7OPTC))THEN
          IF(CLPH(1))THEN
            TMRVAL(P2TG)=0.0D0
            LLD(1,2)=LD2
C=          CALL LDCSH(2,IRPHAS,ICLD)
          ELSE
            IF(LDTRIP(LD2))THEN
              IF(TMRVAL(P2TG) .GT. 0.0D0)TMRVAL(P2TG)=TMRSET(P2TG)+DT
            END IF
          END IF
        END IF
C-----FIGURE 7 NOTE 4 D2A (END)
        IF(TMRVAL(P2TG).GT.0.0D0)THEN
          TMRVAL(P2TG)=TMRVAL(P2TG)-DT
          IF(TMRVAL(P2TG) .LE. 0.0D0)THEN
            TMRVAL(P2TG)=0.0D0
            LLD(1,2)=LD2A
C=          CALL LDCSH(2,IRPHAS,ICLD)
          END IF
        END IF
C-----FIGURE 7 NOTE 4 D7A (RESET)
        IF(CPH(3).AND.CPH(7).AND.LDTRIP(LD7))THEN
          IF(TMRVAL(P7TG) .GT. 0.0D0)TMRVAL(P7TG)=TMRSET(P7TG)+DT
        END IF
C-----FIGURE 7 NOTE 4 D7A (END)
        IF(TMRVAL(P7TG).GT.0.0D0)THEN
          TMRVAL(P7TG)=TMRVAL(P7TG)-DT
          IF(TMRVAL(P7TG) .LE. 0.0D0)THEN
            TMRVAL(P7TG)=0.0D0
            IF(OPTN(F7OPTB))THEN
              LLD(1,7)=LD7A
C=            CALL LDCSH(7,IRPHAS,ICLD)
            ELSE
              LLD(1,3)=LD7A
              NLD(3)=1
C=            CALL LDCSH(3,IRPHAS,ICLD)
            END IF
          END IF
        END IF
      END IF
C
C-----FIGURE 7 PROCESS SPECIAL TIMERS (END)
C
C
C-----PROCESS SPECIAL TIMERS FOR ALL FIGURES (END)
C
  800 CONTINUE
      DO 4500 IRING=1,NRING
      ICPHAS=ICPHAT(IRING)
C[    IF ( SIMGAS )                              STOP 'TX3467 SIMGAP 01'
      IF(SIMGAP)                                 GO TO 4016
C-----CHECK FOR TIMED PHASE COMBINATION TIMEOUT
      IF(SEL(ICPHAS) .AND. (GMT(ICPHAS).EQ.'T')) GO TO 2010
      TP=TPT(IRING)
      TR=TRT(IRING)
      IF(SEL(ICPHAS) .AND. HOLD(ICPHAS))         GO TO 4500
C-----CHECK DEMAND ON RED (START)
      DO 801 I=IFPR(IRING),ILPR(IRING)
      IF(CLPH(I).AND.IDOR(IRING,1))              GO TO  801
      IF((I.EQ.ICPHAS) .AND. (INTER(IRING).EQ.1))GO TO  801
      IF(CLPH(I))IDOR(IRING,1)=.TRUE.
  801 CONTINUE
C-----CHECK DEMAND ON RED (END)
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  01'
      IF(INTER(IRING).GT.1)                      GO TO 4500
C-----CHECK DEMAND ON GREEN (START)
C-----RESET THE GAP TIMER BECAUSE OF DETECTOR ACTUATION ON THIS PHASE
C[    IF ( DFPS(ICPHAS) )                        STOP 'TX3467 DFP    01'
      IF (DFP(ICPHAS) .AND. (TP.GT.TII(ICPHAS)))THEN
        TR = TVI(ICPHAS)
        TRT(IRING)=TR
        SEL(ICPHAS)=.FALSE.
      END IF
      IF ( IDOR(IRING,1) . AND . (EOM(IRING).EQ.TIMERR) )
     *                  EOM(IRING) = DMAX1( TP+TMX(ICPHAS),TMI(ICPHAS) )
      IF ( (EOM(IRING).NE.TIMERR ) . AND .
     *     (TR        .LE.0.0D0  ) )             THEN
        GMT(ICPHAS)='G'
        GO TO 2010
      END IF
      IF ( TP . GE . EOM(IRING) )                THEN
        GMT(ICPHAS)='M'
        GO TO 2010
      END IF
            IF ( TR . LT . TVI(ICPHAS) )                      GO TO 4500
      IF(DFP(ICPHAS))THEN
        CLPH(ICPHAS)=.FALSE.
      END IF
                                                              GO TO 4500
C-----CHECK DEMAND ON GREEN (END)
 2010 CONTINUE
C-----GAP-OUT, MAX-OUT, OR TIME-OUT (TIMED PHASE COMBINATION TIMEOUT)
C;    WRITE (6,601) TIME,STRTIM,IRING,ICPHAS,ICPHAT(1),ICPHAT(2),
C;   1              DMIN1(EOM(IRING),99999.99D0),TPT(IRING),TRT(IRING),
C;   2              GMT(ICPHAS)
C;601 FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' IRING=',I1,
C;   1       ' ICPHAS=',I1,' ICPHAT=',I1,'-',I1,
C;   2       ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,' ',A )
      SEL(ICPHAS)=.TRUE.
      CLPH(ICPHAS)=.FALSE.
C-----DO NOT CHOOSE NEW PHASE FOR RING IF ANY RING IN YELLOW CHANGE OR
C-----RED CLEARANCE
      DO 4015 JRING=1,NRING
      IF(INTER(JRING) .GT. 1)                                 GO TO 4500
 4015 CONTINUE
      IF(HOLD(ICPHAS))                                        GO TO 4500
 4016 CONTINUE
      IF(.NOT. FIG3)                                          GO TO 4500
C
C-----FIGURE 3 CHOOSE NEXT PHASE BASED ON "CLEAR TO" LIST (START)
C
C-----FIGURE 3 NOTE 2.A AND 2.B
      IF(CPH(2).AND.CPH(7))THEN
C[      IF ( IRING            .EQ.-2147483647   )STOP 'TX3467 IRING  02'
        IF(IRING.EQ.1)THEN
C-----FIGURE 3 NOTE 2.A
          IF(OPTN(TLP27H))                                    GO TO 4017
        ELSE
C-----FIGURE 3 NOTE 2.B
          IF(OPTN(TLP27O))                                    GO TO 4017
        END IF
      END IF
C-----USE NORMAL CLEAR-TO SEQUENCE
      IPCLTO=1
      NPCLTO = NPHNXT(ICPHAS)
      INCPCT=1
                                                              GO TO 4018
 4017 CONTINUE
C-----USE REVERSED CLEAR-TO SEQUENCE (NOTE 2)
      IPCLTO=NPHNXT(ICPHAS)
      NPCLTO=1
      INCPCT=-1
 4018 CONTINUE
C[    IF ( INCPCT             .EQ.-2147483647   )STOP 'TX3467 INCPCT 01'
C[    IF ( IPCLTO             .EQ.-2147483647   )STOP 'TX3467 IPCLTO 01'
C[    IF ( NPCLTO             .EQ.-2147483647   )STOP 'TX3467 NPCLTO 01'
      DO 4020  I = IPCLTO , NPCLTO , INCPCT
      NEXTPH = LPHNXT(I,ICPHAS)
      IF ( CLPH(NEXTPH) )THEN
        IF(FIG3)THEN
          IF(STATE(PC25) .AND. (NEXTPH.NE.7))                 GO TO 4020
          IF(STATE(PC37) .AND. (NEXTPH.NE.2))                 GO TO 4020
          IF(STATE(PC2526))THEN
            IF(CPH(5) .AND. (NEXTPH.EQ.1))                    GO TO 4020
            IF((NEXTPH.EQ.3) .OR. (NEXTPH.EQ.7))              GO TO 4020
          END IF
          IF(STATE(PC1737))THEN
            IF(CPH(3) .AND. (NEXTPH.EQ.6))                    GO TO 4020
            IF((NEXTPH.EQ.2) .OR. (NEXTPH.EQ.5))              GO TO 4020
          END IF
          IF(STATE(PC1536))THEN
            IF((NEXTPH.EQ.2).OR.(NEXTPH.EQ.7))                GO TO 4020
            IF(CPH(1) .AND. CPH(5) .AND. (NEXTPH.EQ.6))THEN
              IF(CLPH(3))                                     GO TO 4020
            END IF
            IF(CPH(3) .AND. CPH(6) .AND. (NEXTPH.EQ.1))THEN
              IF(CLPH(5))                                     GO TO 4020
            END IF
          END IF
        END IF
                                                              GO TO 4030
      END IF
 4020 CONTINUE
C[    IF ( DEMANS )                              STOP 'TX3467 DEMAND 01'
      IF(.NOT. DEMAND)                                        GO TO 4500
C-----NO DEMAND FOR ANY PHASE ON CLEAR TO LIST THEREFORE CLEAR TO THE
C-----NEXT PHASE COMBINATION IN PERFERRED SEQUENCE LIST
      IF((CPH(2).AND.CPH(7)) .OR. STATE(PC1737) .OR. STATE(PC2526))THEN
        IF(.NOT. CPH(1))CLPH(1)=.TRUE.
        IF(.NOT. CPH(6))CLPH(6)=.TRUE.
                                                              GO TO 4500
      END IF
      IF((CPH(3).AND.CPH(5)) .OR. STATE(PC25) .OR. STATE(PC37))THEN
        IF(.NOT. CPH(2))CLPH(2)=.TRUE.
        IF(.NOT. CPH(7))CLPH(7)=.TRUE.
                                                              GO TO 4500
      END IF
      IF((CPH(1).AND.CPH(6)) .OR. STATE(PC1536))THEN
        IF(.NOT. CPH(3))CLPH(3)=.TRUE.
        IF(.NOT. CPH(5))CLPH(5)=.TRUE.
                                                              GO TO 4500
      END IF
                                                              GO TO 4500
 4030 CONTINUE
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  03'
      NEXTTT(IRING)=NEXTPH
C
C-----FIGURE 3 CHOOSE NEXT PHASE BASED ON "CLEAR TO" LIST (END)
C
 4500 CONTINUE
C
C-----CHECK DEMAND FOR PHASE FOR ALL FIGURES (END)
C
      IF(FIG3)THEN
        IF(STATE(PC2526))THEN
            IF((NEXTTT(1).EQ.1) .AND. ((NEXTTT(2).EQ.5).OR.CPH(5)))
     *        NEXTTT(2)=6
        END IF
        IF(STATE(PC1737))THEN
            IF((NEXTTT(2).EQ.6) .AND. ((NEXTTT(1).EQ.3).OR.CPH(3)))
     *        NEXTTT(1)=1
        END IF
        GO TO 4700
      END IF
C
C-----FIGURE 4, 6, & 7 CHOOSE NEXT PHASE COMBINATION (START)
C
C-----CHANGE PHASE COMBINATIONS ONLY WHEN BOTH ARE IN GREEN
      DO 4600 JRING=1,NRING
      IF(INTER(JRING).GT.1)                                   GO TO 4700
 4600 CONTINUE
C
C-----NEXT PHASE SELECTION FROM PREFERRED SEQ. OF PHASE COMBINATIONS
C
C-----ONLY ONE RING IS READY TO MOVE
      IF(SEL(ICPHAT(1)) .NEQV. SEL(ICPHAT(2)))THEN
        IF(SEL(ICPHAT(1)))THEN
C-----RING 1 IS READY
          IT1=1
          IT2=2
        ELSE
C-----RING 2 IS READY
          IT1=2
          IT2=1
        END IF
C[      IF ( IT1              .EQ.-2147483647   )STOP 'TX3467 IT1    01'
        IF(HOLD(ICPHAT(IT1)))                                 GO TO 4700
C-----THIS IS A CLEARANCE PHASE COMBINATION
C-----THE NEXT PHASE COMBINATION IS ALREADY KNOWN
        IF(INPC.GT.0)THEN
          IF(IPH(INPC,IT1).NE.ICPHAT(IT1))THEN
            NEXTTT(IT1)=IPH(INPC,IT1)
            IOPC=ICPC
            ICPC=INPC
            INPC=0
          END IF
                                                              GO TO 4700
        END IF
C-----CHECK THE PREFERRED SEQUENCE LIST
        DO 4610 II=2,NPS(ICPC)
        IPST=IPS(II,ICPC)
C[      IF ( IT2              .EQ.-2147483647   )STOP 'TX3467 IT2    01'
        IF(CLPH(IPH(IPST,IT1)).AND.(ICPHAT(IT2).EQ.IPH(IPST,IT2)))THEN
          IOPC=ICPC
          ICPC=IPC(IOPC,IPST)
          IF(ICPC.GT.0)THEN
            INPC=IPST
          ELSE
            ICPC=IPST
          END IF
          NEXTTT(IT1)=IPH(ICPC,IT1)
                                                              GO TO 4620
        END IF
 4610   CONTINUE
C-----IF TIME REMAINING ON THE GAP TIMER FOR THE RING NOT READY TO MOVE
C-----THEN WAIT
C[      IF ( IT2              .EQ.-2147483647   )STOP 'TX3467 IT2    02'
        IF(TRT(IT2) .GT. 0.0D0)                               GO TO 4700
        DO 4612 II=2,NPS(ICPC)
        IPST=IPS(II,ICPC)
C[      IF ( IT1              .EQ.-2147483647   )STOP 'TX3467 IT1    02'
        IF(CLPH(IPH(IPST,IT1)))THEN
          IOPC=ICPC
          ICPC=IPC(IOPC,IPST)
          IF(ICPC.GT.0)THEN
            INPC=IPST
            IF(IPH(ICPC,1).NE.ICPHAT(1))THEN
              NEXTTT(1)=IPH(ICPC,1)
            ELSE
              NEXTTT(2)=IPH(ICPC,2)
            END IF
          ELSE
            ICPC=IPST
            IF(IPH(ICPC,1).NE.ICPHAT(1))THEN
              NEXTTT(1)=IPH(ICPC,1)
            END IF
            IF(IPH(ICPC,2).NE.ICPHAT(2))THEN
              NEXTTT(2)=IPH(ICPC,2)
            END IF
          END IF
                                                              GO TO 4620
        END IF
 4612   CONTINUE
C-----NO DEMAND FOR ANY PHASE COMBINATION ON CLEAR TO LIST
C-----IF DEMAND ON RED FOR ANY RING THEN CALL THE FIRST PHASE
C-----COMBINATION ON THE CLEAR TO LIST
C[      IF ( DEMANS )                            STOP 'TX3467 DEMAND 02'
        IF(DEMAND)                                            GO TO 4615
C-----IF YOU CAN REST IN CURRENT PHASE COMBINATION THEN DO NOT CHANGE
        IF(REST(ICPC))                                        GO TO 4620
 4615   CONTINUE
C-----CALL THE FIRST PHASE COMBINATION ON THE CLEAR TO LIST
        IPST=IPS(2,ICPC)
        IT1=IPH(IPST,1)
        IT2=IPH(IPST,2)
        IF(IPH(ICPC,1) .NE. IT1)CLPH(IT1)=.TRUE.
        IF(IPH(ICPC,2) .NE. IT2)CLPH(IT2)=.TRUE.
                                                              GO TO 4700
 4620   CONTINUE
C-----END ONLY 1 RING READY
                                                              GO TO 4700
      END IF
C-----BOTH RINGS READY TO MOVE
      IF(SEL(ICPHAT(1)) .AND. SEL(ICPHAT(2)) .AND.
     *   (.NOT. HOLD(ICPHAT(1))).AND.(.NOT. HOLD(ICPHAT(2))))THEN
C-----THIS IS A CLEARANCE PHASE COMBINATION
C-----THE NEXT PHASE COMBINATION IS ALREADY KNOWN
        IF(INPC.GT.0)THEN
           IF(IPH(INPC,1).NE.ICPHAT(1))NEXTTT(1)=IPH(INPC,1)
           IF(IPH(INPC,2).NE.ICPHAT(2))NEXTTT(2)=IPH(INPC,2)
           IOPC=ICPC
           ICPC=INPC
           INPC=0
                                                              GO TO 4700
        END IF
C-----IPST - POSSIBLE NEXT PHASE COMBINATION
C-----IT1 - PHASE IN RING 1
C-----IT2 - PHASE IN RING 2
        DO 4650 II=2,NPS(ICPC)
        IPST=IPS(II,ICPC)
        IT1=IPH(IPST,1)
        IT2=IPH(IPST,2)
C-----BOTH PHASES IN THE NEXT POSSIBLE COMBINATION ARE DIFFERENT
C-----FROM THE CURRENT COMBINATION.  BOTH MUST HAVE CALL FOR THE NEXT
C-----COMBINATION TO BE SELECTED
        IF((ICPHAT(1).NE.IT1) .AND. (ICPHAT(2).NE.IT2))THEN
          IF((.NOT. CLPH(IT1)).OR.(.NOT. CLPH(IT2)))          GO TO 4650
          IOPC=ICPC
          ICPC=IPC(IOPC,IPST)
C-----MUST GO THRU A CLEARANCE PHASE COMBINATION
C-----ONLY ONE PHASES WILL CHANGE
          IF(ICPC.GT.0)THEN
            INPC=IPST
            IF(IPH(ICPC,1).NE.ICPHAT(1))THEN
              NEXTTT(1)=IPH(ICPC,1)
            ELSE
              NEXTTT(2)=IPH(ICPC,2)
            END IF
          ELSE
            ICPC=IPST
            NEXTTT(1)=IT1
            NEXTTT(2)=IT2
          END IF
                                                              GO TO 4700
        ELSE
C-----ONLY ONE OF THE PHASES IN THE NEXT POSSIBLE COMBINATION IS
C-----DIFFERENT. THE DIFFERENT PHASE MUST HAVE A CALL FOR THE NEXT
C-----COMBINATION TO BE SELECTED.
          IF(ICPHAT(1).NE.IT1)THEN
C-----PHASE IN RING 1 IS DIFFERENT
            IF(.NOT. CLPH(IT1))                               GO TO 4650
            NEXTTT(1)=IT1
            ICPC=IPST
          ELSE
C-----PHASE IN RING 2 IS DIFFERENT
            IF(.NOT. CLPH(IT2))                               GO TO 4650
            NEXTTT(2)=IT2
            ICPC=IPST
          END IF
                                                              GO TO 4700
        END IF
 4650   CONTINUE
C-----NO DEMAND FOR ANY PHASE COMBINATION ON CLEAR TO LIST
C-----IF DEMAND ON RED FOR ANY RING THEN CLEAR TO THE FIRST
C-----PHASE COMBINATION ON THE CLEAR TO LIST
C[      IF ( DEMANS )                            STOP 'TX3467 DEMAND 03'
        IF(DEMAND)                                            GO TO 4653
C-----IF YOU CAN REST IN CURRENT PHASE COMBINATION THEN DO NOT CHANGE
        IF(REST(ICPC))                                        GO TO 4655
 4653   CONTINUE
C-----CALL THE FIRST PHASE COMBINATION ON THE CLEAR TO LIST
        IPST=IPS(2,ICPC)
        IT1=IPH(IPST,1)
        IT2=IPH(IPST,2)
        IF(IPH(ICPC,1) .NE. IT1)CLPH(IT1)=.TRUE.
        IF(IPH(ICPC,2) .NE. IT2)CLPH(IT2)=.TRUE.
                                                              GO TO 4700
 4655   CONTINUE
C-----END BOTH RINGS READY
      END IF
C
C-----FIGURE 4, 6, & 7 CHOOSE NEXT PHASE COMBINATION (END)
C
 4700 CONTINUE
C
C-----NEXTTT SET FOR BOTH RINGS FOR ALL FIGURES
C
C-----FIGURE 3 NOTE 3.E SIMGAP (END)
      IF(FIG3 .AND. (TMRSET(F3P35G).EQ.99.0D0) .AND. STATE(PC35))THEN
        IF(SEL(3) .AND. SEL(5))THEN
          HOLD(3)=.FALSE.
          HOLD(5)=.FALSE.
          STATE(PC35)=.FALSE.
          SIMGAP=.TRUE.
C[        SIMGAS = .FALSE.
                                                              GO TO  800
        END IF
      END IF
C-----FIGURE 6 NOTE 3 OPTION A = OFF SIMGAP (END)
      IF(FIG6 .AND. STATE(PC36))THEN
        IF(SEL(3) .AND. SEL(6))THEN
          HOLD(3)=.FALSE.
          HOLD(6)=.FALSE.
          STATE(PC36)=.FALSE.
          SIMGAP=.TRUE.
C[        SIMGAS = .FALSE.
                                                              GO TO  800
        END IF
      END IF
C-----FIGURE 7 NOTE 3 OPTION A = OFF SIMGAP (END)
      IF(FIG7 .AND. STATE(PC15))THEN
        IF(SEL(1) .AND. SEL(5))THEN
          HOLD(1)=.FALSE.
          HOLD(5)=.FALSE.
          STATE(PC15)=.FALSE.
          SIMGAP=.TRUE.
C[        SIMGAS = .FALSE.
                                                              GO TO  800
        END IF
      END IF
C
C-----PROCESS EACH RING BY INTERVAL TYPE FOR ALL FIGURES (START)
C
      DO 7000 IRING=1,NRING
      ICPHAS=ICPHAT(IRING)
      GO TO ( 4900,5010,6010 ) , INTER(IRING)
 4900 CONTINUE
C
C-----PROCESS INTERVAL 1 = GREEN FOR ALL FIGURES (START)
C
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  04'
      IF(NEXTTT(IRING).EQ.0)                                  GO TO 7000
      NEXTPH=NEXTTT(IRING)
      NEXT(NEXTPH)=.TRUE.
      NEXTPT(IRING)=NEXTPH
      SEL(ICPHAS)=.FALSE.
C-----IF MEMORY CALL IS NOT DEACTIVATED
C-----AND THERE IS TIME LEFT ON THE GAP TIMER WHEN GREEN ENDS
C-----PUT A CALL ON THIS PHASE
C-----(DEACTIVATION IS NOT IMPLEMENTED)
      IF((IMEM(ICPHAS).EQ.IYES).AND.(TRT(IRING).GT.0.0D0))THEN
        CLPH(ICPHAS)=.TRUE.
      END IF
C
C-----PROCESS START OF YELLOW CHANGE FOR ALL FIGURES (START)
C
      IF ( TIME . GT . STRTIM )THEN
        DO 4910  ICPCOM = 1 , NPC
        IF ( (IPH(ICPCOM,1) . EQ . ICPHAT(1)) . AND .
     *       (IPH(ICPCOM,2) . EQ . ICPHAT(2)) )               GO TO 4920
 4910   CONTINUE
                                                              GO TO 9320
 4920   CONTINUE
C[      IF ( IRING            .EQ.-2147483647   )STOP 'TX3467 IRING  05'
        JRING = 3 - IRING
C ------- GAP-OUT
        IF(GMT(ICPHAS).EQ.'G')THEN
          NGAPPH(ICPHAS) = NGAPPH(ICPHAS) + 1
          TGAPPH(ICPHAS) = TGAPPH(ICPHAS) + TPT(IRING)
C;        WRITE (6,602) TIME,STRTIM,IRING,ICPHAS,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(IRING),99999.99D0),TPT(IRING),
C;   2                  TRT(IRING),NGAPPH(ICPHAS),TGAPPH(ICPHAS)
C;602     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' IRING=',I1,
C;   1           ' ICPHAS=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' GAP PH',' NGAPPH=',I3,' TGAPPH=',F7.2)
C[        IF ( ICPCOM         .EQ.-2147483647   )STOP 'TX3467 ICPCOM 01'
          NGAPPC(ICPCOM) = NGAPPC(ICPCOM) + 1
          TGAPPC(ICPCOM) = TGAPPC(ICPCOM) + DMIN1( TPT(1),TPT(2) )
C;        WRITE (6,603) TIME,STRTIM,JRING,ICPCOM,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(JRING),99999.99D0),TPT(JRING),
C;   2                  TRT(JRING),NGAPPC(ICPCOM),TGAPPC(ICPCOM)
C;603     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' JRING=',I1,
C;   1           ' ICPCOM=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' GAP PC',' NGAPPC=',I3,' TGAPPC=',F7.2)
        END IF
C ------- MAX-OUT
        IF(GMT(ICPHAS).EQ.'M')THEN
          NMAXPH(ICPHAS) = NMAXPH(ICPHAS) + 1
C[        IF ( IRING          .EQ.-2147483647   )STOP 'TX3467 IRING  06'
          TMAXPH(ICPHAS) = TMAXPH(ICPHAS) + TPT(IRING)
C;        WRITE (6,604) TIME,STRTIM,IRING,ICPHAS,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(IRING),99999.99D0),TPT(IRING),
C;   2                  TRT(IRING),NMAXPH(ICPHAS),TMAXPH(ICPHAS)
C;604     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' IRING=',I1,
C;   1           ' ICPHAS=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' MAX PH',' NMAXPH=',I3,' TMAXPH=',F7.2)
C[        IF ( ICPCOM         .EQ.-2147483647   )STOP 'TX3467 ICPCOM 02'
          NMAXPC(ICPCOM) = NMAXPC(ICPCOM) + 1
          TMAXPC(ICPCOM) = TMAXPC(ICPCOM) + DMIN1( TPT(1),TPT(2) )
C;        WRITE (6,605) TIME,STRTIM,JRING,ICPCOM,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(JRING),99999.99D0),TPT(JRING),
C;   2                  TRT(JRING),NMAXPC(ICPCOM),TMAXPC(ICPCOM)
C;605     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' JRING=',I1,
C;   1           ' ICPCOM=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' MAX PC',' NMAXPC=',I3,' TMAXPC=',F7.2)
        END IF
C ------- TIME-OUT
        IF(GMT(ICPHAS).EQ.'T')THEN
          NTIMPH(ICPHAS) = NTIMPH(ICPHAS) + 1
C[        IF ( IRING          .EQ.-2147483647   )STOP 'TX3467 IRING  07'
          TTIMPH(ICPHAS) = TTIMPH(ICPHAS) + TPT(IRING)
C;        WRITE (6,606) TIME,STRTIM,IRING,ICPHAS,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(IRING),99999.99D0),TPT(IRING),
C;   2                  TRT(IRING),NTIMPH(ICPHAS),TTIMPH(ICPHAS)
C;606     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' IRING=',I1,
C;   1           ' ICPHAS=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' TIM PH',' NTIMPH=',I3,' TTIMPH=',F7.2)
C[        IF ( ICPCOM         .EQ.-2147483647   )STOP 'TX3467 ICPCOM 03'
          NTIMPC(ICPCOM) = NTIMPC(ICPCOM) + 1
          TTIMPC(ICPCOM) = TTIMPC(ICPCOM) + DMIN1( TPT(1),TPT(2) )
C;        WRITE (6,607) TIME,STRTIM,JRING,ICPCOM,ICPHAT(1),ICPHAT(2),
C;   1                  DMIN1(EOM(JRING),99999.99D0),TPT(JRING),
C;   2                  TRT(JRING),NTIMPC(ICPCOM),TTIMPC(ICPCOM)
C;607     FORMAT(' TIME=',F7.2,' STRTIM=',F7.2,' JRING=',I1,
C;   1           ' ICPCOM=',I1,' ICPHAT=',I1,'-',I1,
C;   2           ' EOM=',F7.2,' TP=',F7.2,' TR=',F7.2,
C;   3           ' TIM PC',' NTIMPC=',I3,' TTIMPC=',F7.2)
        END IF
      END IF
      GMT(ICPHAS)=' '
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  08'
      EOM(IRING) = TIMERR
      TR = TCI(ICPHAS)
      TRT(IRING)=TR
      ICAMCT(IRING) = ICAMCT(IRING) + 1
      NEWCSP=.TRUE.
C[    NEWCSS     = .FALSE.
      INTER(IRING) = 2
C
C-----FIGURE 3 PROCESS START OF YELLOW CHANGE (START)
C
      IF(FIG3)THEN
C-----FIGURE 3 DIAMOND OPERATION NOTE 2 INTERVAL 2 (START)
        IF((IRING.EQ.1) .AND. CPH(7) .AND. NEXT(1))THEN
          IF(.NOT. NEXT(6))THEN
            TMRVAL(P17AG)=TMRSET(P17AG)
            HOLD(1)=.TRUE.
            HOLD(7)=.TRUE.
          END IF
        END IF
C-----FIGURE 3 DIAMOND OPERATION NOTE 2 INTERVAL 3 (START)
        IF((IRING.EQ.2) .AND. CPH(2) .AND. NEXT(6))THEN
          IF(.NOT. NEXT(1))THEN
            TMRVAL(P26AG)=TMRSET(P26AG)
            HOLD(2)=.TRUE.
            HOLD(6)=.TRUE.
          END IF
        END IF
      END IF
C
C-----FIGURE 3 PROCESS START OF YELLOW CHANGE (END)
C
C
C-----FIGURE 4 PROCESS START OF YELLOW CHANGE (START)
C
      IF(FIG4)THEN
C-----FIGURE 4 DIAMOND OPERATION NOTE 2 INTERVAL 2 (START)
        IF((IRING.EQ.1) .AND. CPH(7) .AND. NEXT(1))THEN
          TMRVAL(P17AG)=TMRSET(P17AG)
          HOLD(1)=.TRUE.
          HOLD(7)=.TRUE.
        END IF
C-----FIGURE 4 DIAMOND OPERATION NOTE 2 INTERVAL 3 (START)
        IF((IRING.EQ.2) .AND. CPH(2) .AND. NEXT(6))THEN
          TMRVAL(P26AG)=TMRSET(P26AG)
          HOLD(2)=.TRUE.
          HOLD(6)=.TRUE.
        END IF
      END IF
C
C-----FIGURE 4 PROCESS START OF YELLOW CHANGE (END)
C
C
C-----FIGURE 6 PROCESS START OF YELLOW CHANGE (START)
C
      IF(FIG6)THEN
C-----FIGURE 6 NOTE 3 OPTION A = OFF MAXIMUM (END)
        IF(STATE(PC16))THEN
          TMRVAL(F6P16H)=0.0D0
          STATE(PC16)=.FALSE.
        END IF
C-----FIGURE 6 NOTE 3 OPTION A = OFF MINIMUM AND MAXIMUM (START)
        IF((IRING.EQ.1) .AND. CPH(6) .AND. NEXT(1))THEN
          IF(.NOT. OPTN(F6OPTA))THEN
            TMRVAL(F6P16L)=TMRSET(F6P16L)
            TMRVAL(F6P16H)=TMRSET(F6P16H)
            HOLD(1)=.TRUE.
            HOLD(6)=.TRUE.
            STATE(PC16)=.TRUE.
          END IF
        END IF
C-----FIGURE 6 DIAMOND OPERATION NOTE 2 INTERVAL 2 (START)
        IF((IRING.EQ.1) .AND. CPH(7) .AND. NEXT(1))THEN
          TMRVAL(P17AG)=TMRSET(P17AG)
          HOLD(1)=.TRUE.
          HOLD(7)=.TRUE.
        END IF
C-----FIGURE 6 PHASE 2-6 ADVANCE GREEN TIMER (START)
        IF((IRING.EQ.2) .AND. CPH(2) .AND. NEXT(6))THEN
          TMRVAL(P26AG)=TMRSET(P26AG)
          HOLD(2)=.TRUE.
          HOLD(6)=.TRUE.
        END IF
      END IF
C
C-----FIGURE 6 PROCESS START OF YELLOW CHANGE (END)
C
C
C-----FIGURE 7 PROCESS START OF YELLOW CHANGE (START)
C
      IF(FIG7)THEN
C-----FIGURE 7 NOTE 3 OPTION A = OFF MAXIMUM (END)
        IF(STATE(PC16))THEN
          TMRVAL(F7P16H)=0.0D0
          STATE(PC16)=.FALSE.
        END IF
C-----FIGURE 7 NOTE 3 OPTION A = OFF MINIMUM AND MAXIMUM (START)
        IF((IRING.EQ.2) .AND. CPH(1) .AND. NEXT(6))THEN
          IF(.NOT. OPTN(F7OPTA))THEN
            TMRVAL(F7P16L)=TMRSET(F7P16L)
            TMRVAL(F7P16H)=TMRSET(F7P16H)
            HOLD(1)=.TRUE.
            HOLD(6)=.TRUE.
            STATE(PC16)=.TRUE.
          END IF
        END IF
C-----FIGURE 7 PHASE 1-7 ADVANCE GREEN TIMER (START)
        IF((IRING.EQ.1) .AND. CPH(7) .AND. NEXT(1))THEN
          TMRVAL(P17AG)=TMRSET(P17AG)
          HOLD(1)=.TRUE.
          HOLD(7)=.TRUE.
        END IF
C-----FIGURE 7 DIAMOND OPERATION NOTE 2 INTERVAL 3 (START)
        IF((IRING.EQ.2) .AND. CPH(2) .AND. NEXT(6))THEN
          TMRVAL(P26AG)=TMRSET(P26AG)
          HOLD(2)=.TRUE.
          HOLD(6)=.TRUE.
        END IF
      END IF
C
C-----FIGURE 7 PROCESS START OF YELLOW CHANGE (END)
C
C
C-----PROCESS START OF YELLOW CHANGE FOR ALL FIGURES (END)
C
C
C-----PROCESS INTERVAL 1 = GREEN FOR ALL FIGURES (END)
C
 5010 CONTINUE
C
C-----PROCESS INTERVAL 2 = YELLOW CHANGE FOR ALL FIGURES (START)
C
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  09'
                    IF ( TRT(IRING) . GT . 0.0D0 )            GO TO 7000
      TR = TAR(ICPHAS)
      TRT(IRING)=TR
      ICAMCT(IRING) = ICAMPS(ICPHAS) + 2
      NEWCSP=.TRUE.
C[    NEWCSS     = .FALSE.
      INTER(IRING) = 3
C
C-----PROCESS INTERVAL 2 = YELLOW CHANGE FOR ALL FIGURES (END)
C
 6010 CONTINUE
C
C-----PROCESS INTERVAL 3 = RED CLEARANCE FOR ALL FIGURES (START)
C
C[    IF ( IRING              .EQ.-2147483647   )STOP 'TX3467 IRING  10'
                    IF ( TRT(IRING) . GT . 0.0D0 )            GO TO 7000
      IF(IOPHAS(IRING).GT.0)OPH(IOPHAS(IRING))=.FALSE.
      IOPHAS(IRING) = ICPHAS
      OPH(ICPHAS)=.TRUE.
      IF(IRING.EQ.1)THEN
        IF(IOPHAS(2).GT.0)OPH(IOPHAS(2))=.FALSE.
        IOPHAS(2)=ICPHAT(2)
        OPH(ICPHAT(2))=.TRUE.
      ELSE
        IF(IOPHAS(1).GT.0)OPH(IOPHAS(1))=.FALSE.
        IOPHAS(1)=ICPHAT(1)
        OPH(ICPHAT(1))=.TRUE.
      END IF
      NEXTPH=NEXTPT(IRING)
      CPH(ICPHAT(IRING))=.FALSE.
      ICPHAT(IRING) = NEXTPH
      CPH(NEXTPH)=.TRUE.
      ICAMCT(IRING) = ICAMPS(NEXTPH)
      NEWCSP=.TRUE.
C[    NEWCSS     = .FALSE.
      INTER(IRING)=1
      IDOR(IRING,1)=.FALSE.
      CLPH(NEXTPH)=.FALSE.
      NEXT(NEXTPH)=.FALSE.
      NEXTTT(IRING)=0
      TP = 0.0D0
      TPT(IRING)=TP
      TR = TMI(NEXTPH)
      TRT(IRING)=TR
      NEWPH(IRING)=.TRUE.
C[    NEWPHS(IRING) = .FALSE.
C
C-----PROCESS INTERVAL 3 = RED CLEARANCE FOR ALL FIGURES (END)
C
 7000 CONTINUE
C
C-----PROCESS EACH RING BY INTERVAL TYPE FOR ALL FIGURES (END)
C
C
C-----PROCESS LOOP DETECTOR CHANGES EACH DT FOR ALL FIGURES (START)
C
C-----PROCESS LOOP DETECTOR CHANGES EACH DT FOR FIGURE 4 (START)
        IF(FIG4)THEN
C-----FIGURE 4 NOTE 2 D2 & D2A (START)
          IF(CPH(2) .AND. CPH(5) .AND. CLPH(3) .AND. CLPH(6))THEN
            IF(TMRVAL(P2TG) .EQ. 0.0D0)TMRVAL(P2TG)=TMRSET(P2TG)
          END IF
C-----FIGURE 4 NOTE 2 D7 & D7A (START)
          IF(CPH(3) .AND. CPH(7) .AND. CLPH(1) .AND. CLPH(5))THEN
            IF(TMRVAL(P7TG) .EQ. 0.0D0)TMRVAL(P7TG)=TMRSET(P7TG)
          END IF
        END IF
C-----PROCESS LOOP DETECTOR CHANGES EACH DT FOR FIGURE 4 (END)
C
C-----PROCESS LOOP DETECTOR CHANGES EACH DT FOR ALL FIGURES (END)
C
C
C-----PROCESS NEW CAMSTACK POSITION FOR ALL FIGURES (START)
C
C[    IF ( NEWCSS )                              STOP 'TX3467 NEWCSP 01'
      IF(NEWCSP)THEN
        CALL TOGCS
        CALL MAKECS(ICAMCT(1),ICAMCT(2),ICAMPC)
        CALL OVLP
      END IF
C
C-----PROCESS NEW CAMSTACK POSITION FOR ALL FIGURES (END)
C
C[    IF ( NEWPHS(1) )                           STOP 'TX3467 NEWPH  01'
C[    IF ( NEWPHS(2) )                           STOP 'TX3467 NEWPH  02'
      IF((.NOT. NEWPH(1)) .AND. (.NOT. NEWPH(2)))             GO TO 8020
 7010 CONTINUE
C
C-----PROCESS NEW PHASE COMBINATION FOR ALL FIGURES (START)
C
C
C-----FIGURE 3 PROCESS NEW PHASE COMBINATION (START)
C
      IF(FIG3)THEN
        STATE(PC17)=.FALSE.
        IF(CPH(1) .AND. CPH(7))STATE(PC17)=.TRUE.
        STATE(PC25)=.FALSE.
        STATE(PC37)=.FALSE.
        IF(OPH(3) .AND. OPH(5))THEN
          IF(CPH(2) .AND. CPH(5))THEN
            HOLD(2)=.TRUE.
            STATE(PC25)=.TRUE.
          END IF
          IF(CPH(3) .AND. CPH(7))THEN
            HOLD(7)=.TRUE.
            STATE(PC37)=.TRUE.
          END IF
        END IF
        STATE(PC26)=.FALSE.
        IF(CPH(2) .AND. CPH(6))STATE(PC26)=.TRUE.
        STATE(PC27)=.FALSE.
C-----FIGURE 3 NOTE 3.C (START)
        IF(CPH(2) .AND. CPH(7))THEN
          HOLD(2)=.TRUE.
          HOLD(7)=.TRUE.
          STATE(PC27)=.TRUE.
C-----FIGURE 3 NOTE 3.D (2-7 OCCURS)
          IF(CLPH(1))CLPH(6)=.TRUE.
          IF(CLPH(6))CLPH(1)=.TRUE.
        END IF
        STATE(PC35)=.FALSE.
C-----FIGURE 3 NOTE 3.E (START)
        IF(CPH(3) .AND. CPH(5))THEN
          IF(TMRSET(F3P35G).NE.99.0D0)TMRVAL(F3P35G)=TMRSET(F3P35G)
          HOLD(3)=.TRUE.
          HOLD(5)=.TRUE.
          STATE(PC35)=.TRUE.
        END IF
        STATE(PC1536)=.FALSE.
        IF((CPH(3).AND.CPH(6)) .OR. (CPH(1).AND.CPH(5)))THEN
          STATE(PC1536)=.TRUE.
        END IF
        IF(CPH(1) .AND. CPH(6))THEN
          STATE(PC1737)=.FALSE.
          STATE(PC2526)=.FALSE.
        END IF
        IF(OPH(2) .AND. OPH(7))THEN
          IF(CPH(7))STATE(PC1737)=.TRUE.
          IF(CPH(2))STATE(PC2526)=.TRUE.
        END IF
C-----FIGURE 3 NOTE 1 D13
        IF(CPH(2))THEN
          NLD(3)=2
        ELSE
          NLD(3)=1
        END IF
C=      CALL LDCSH(3,IRPHAS,ICLD)
C-----FIGURE 3 NOTE 1 D56
        IF(CPH(7))THEN
          NLD(5)=2
        ELSE
          NLD(5)=1
        END IF
C=      CALL LDCSH(5,IRPHAS,ICLD)
C-----FIGURE 3 NOTE 3.B
        IF((STATE(PC1536) .OR. (CPH(1).AND.CPH(6))) .AND.
     *     (CLPH(2) .OR. CLPH(7)))THEN
           CLPH(3)=.TRUE.
           CLPH(5)=.TRUE.
        END IF
      END IF
C
C-----FIGURE 3 PROCESS NEW PHASE COMBINATION (END)
C
C
C-----FIGURE 4 PROCESS NEW PHASE COMBINATION (START)
C
      IF(FIG4)THEN
        STATE(PC17)=.FALSE.
        IF(ICPC .EQ. PC17)STATE(PC17)=.TRUE.
        STATE(PC26)=.FALSE.
        IF(ICPC .EQ. PC26)STATE(PC26)=.TRUE.
C-----FIGURE 4 NOTE 1 PHASE 3-5 CLEARANCE GREEN TIMER (START)
        STATE(PC35)=.FALSE.
        IF(ICPC .EQ. PC35)THEN
          TMRVAL(F4P35G)=TMRSET(F4P35G)
          HOLD(3)=.TRUE.
          HOLD(5)=.TRUE.
          STATE(PC35)=.TRUE.
        END IF
C-----FIGURE 4 NOTE 2 D2 & D2A (RESET)
        IF(ICPC .EQ. PC36)THEN
          TMRVAL(P2TG)=0.0D0
          LLD(1,2)=LD2
C=        CALL LDCSH(2,IRPHAS,ICLD)
        END IF
C-----FIGURE 4 NOTE 2 D7 & D7A (RESET)
        IF(ICPC .EQ. PC15)THEN
          TMRVAL(P7TG)=0.0D0
          LLD(1,7)=LD7
C=        CALL LDCSH(7,IRPHAS,ICLD)
        END IF
C-----FIGURE 4 NOTE 2 D3 & D13 & D5 & D56
C-----  PHASE   D3  D13   D5  D56
C-----   1-5   YES       YES  YES
C-----   1-6   N/A  N/A  N/A  N/A
C-----   1-7
C-----   2-5   YES  YES  OPT  OPT
C-----   2-6
C-----   2-7   N/A  N/A  N/A  N/A
C-----   3-5   YES  YES  YES  YES
C-----   3-6   YES  YES  YES
C-----   3-7   OPT  OPT  YES  YES
C-----FIGURE 4 NOTE 2 D3 & D13
        NLD(3)=0
        IF(ICPC .EQ. PC15)THEN
          LLD(1,3)=LD3
          NLD(3)=1
        END IF
        IF((ICPC.EQ.PC25) .OR. (ICPC.EQ.PC35) .OR. (ICPC.EQ.PC36))THEN
          LLD(1,3)=LD3
          LLD(2,3)=LD13
          NLD(3)=2
        END IF
        IF(ICPC .EQ. PC37)THEN
          IF(OPTN(D03P37))THEN
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD3
              LLD(2,3)=LD13
              NLD(3)=2
            ELSE
              LLD(1,3)=LD3
              NLD(3)=1
            END IF
          ELSE
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD13
              NLD(3)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(3,IRPHAS,ICLD)
C-----FIGURE 4 NOTE 2 D5 & D56
        NLD(5)=0
        IF(ICPC .EQ. PC36)THEN
          LLD(1,5)=LD5
          NLD(5)=1
        END IF
        IF((ICPC.EQ.PC15) .OR. (ICPC.EQ.PC35) .OR. (ICPC.EQ.PC37))THEN
          LLD(1,5)=LD5
          LLD(2,5)=LD56
          NLD(5)=2
        END IF
        IF(ICPC .EQ. PC25)THEN
          IF(OPTN(D05P25))THEN
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD5
              LLD(2,5)=LD56
              NLD(5)=2
            ELSE
              LLD(1,5)=LD5
              NLD(5)=1
            END IF
          ELSE
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD56
              NLD(5)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(5,IRPHAS,ICLD)
      END IF
C
C-----FIGURE 4 PROCESS NEW PHASE COMBINATION (END)
C
C
C-----FIGURE 6 PROCESS NEW PHASE COMBINATION (START)
C
      IF(FIG6)THEN
        IF((ICPC.EQ.PC16) .AND.
     *     (.NOT. OPTN(F6OPTA)) .AND.
     *     (TMRSET(F6P16L).GT.0.0D0))   CLPH(5)=.TRUE.
C-----FIGURE 6 NOTE 3 OPTION C = ON (START)
        STATE(PC17)=.FALSE.
        IF(ICPC .EQ. PC17)STATE(PC17)=.TRUE.
C-----FIGURE 6 NOTE 4 D2A (START)
        IF(ICPC .EQ. PC25)TMRVAL(P2TG)=TMRSET(P2TG)
C-----FIGURE 6 NOTE 4 D2A (END)
        IF(ICPC .NE. PC25)THEN
          TMRVAL(P2TG)=0.0D0
          LLD(1,2)=LD2
C=        CALL LDCSH(2,IRPHAS,ICLD)
        END IF
C-----FIGURE 6 NOTE 3 OPTION B = OFF (START)
        STATE(PC27)=.FALSE.
        IF((ICPC.EQ.PC27) .AND. (.NOT. OPTN(F6OPTB)))THEN
          TMRVAL(F6P27G)=TMRSET(F6P27G)
          HOLD(2)=.TRUE.
          HOLD(7)=.TRUE.
          STATE(PC27)=.TRUE.
        END IF
C-----FIGURE 6 NOTE 3 OPTION C = OFF (START)
        STATE(PC35)=.FALSE.
        IF(ICPC .EQ. PC35)THEN
          TMRVAL(F4P35G)=TMRSET(F4P35G)
          HOLD(3)=.TRUE.
          HOLD(5)=.TRUE.
          STATE(PC35)=.TRUE.
        END IF
C-----FIGURE 6 NOTE 3 OPTION A = OFF SIMGAP (START)
        IF((ICPC.EQ.PC36) .AND. (.NOT. OPTN(F6OPTA)))THEN
          HOLD(3)=.TRUE.
          HOLD(6)=.TRUE.
          STATE(PC36)=.TRUE.
        END IF
C-----FIGURE 6 NOTE 4 D7A (START)
        IF((ICPC.EQ.PC37) .AND. OPTN(F6OPTC))THEN
          IF(CLPH(1) .AND. (.NOT. CLPH(6))) TMRVAL(P7TG)=TMRSET(P7TG)
        END IF
C-----FIGURE 6 NOTE 4 D7A (END)
        IF(ICPC .NE. PC37)THEN
          TMRVAL(P7TG)=0.0D0
          LLD(1,7)=LD7
C=        CALL LDCSH(7,IRPHAS,ICLD)
        END IF
C-----FIGURE 6 NOTE 4 D3 & D13 & D5 & D56
C-----  PHASE   D3  D13   D5  D56
C-----   1-5   YES       YES  YES
C-----   1-6   YES       YES
C-----   1-7   YES       YES
C-----   2-5   YES  PH1  OPT  OPT
C-----   2-6   YES       YES
C-----   2-7   YES       YES
C-----   3-5   YES  YES  YES  YES
C-----   3-6   YES  YES  YES
C-----   3-7   OPT  OPT  YES  PH6
C-----FIGURE 6 NOTE 4 D3 & D13
        NLD(3)=0
        IF((ICPC.EQ.PC15) .OR. (ICPC.EQ.PC16) .OR.
     *     (ICPC.EQ.PC17) .OR. (ICPC.EQ.PC25) .OR.
     *     (ICPC.EQ.PC26) .OR. (ICPC.EQ.PC27))THEN
          LLD(1,3)=LD3
          NLD(3)=1
        END IF
        IF((ICPC.EQ.PC35) .OR. (ICPC.EQ.PC36))THEN
          LLD(1,3)=LD3
          LLD(2,3)=LD13
          NLD(3)=2
        END IF
        IF(ICPC .EQ. PC37)THEN
          IF(OPTN(D03P37))THEN
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD3
              LLD(2,3)=LD13
              NLD(3)=2
            ELSE
              LLD(1,3)=LD3
              NLD(3)=1
            END IF
          ELSE
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD13
              NLD(3)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(3,IRPHAS,ICLD)
        NLD(1)=1
        IF(ICPC .EQ. PC25)THEN
          LLD(2,1)=LD13
          NLD(1)=2
        END IF
C=      CALL LDCSH(1,IRPHAS,ICLD)
C-----FIGURE 6 NOTE 4 D5 & D56
        NLD(5)=0
        IF((ICPC.EQ.PC16) .OR. (ICPC.EQ.PC17) .OR.
     *     (ICPC.EQ.PC26) .OR. (ICPC.EQ.PC27) .OR.
     *     (ICPC.EQ.PC36) .OR. (ICPC.EQ.PC37))THEN
          LLD(1,5)=LD5
          NLD(5)=1
        END IF
        IF((ICPC.EQ.PC15) .OR. (ICPC.EQ.PC35))THEN
          LLD(1,5)=LD5
          LLD(2,5)=LD56
          NLD(5)=2
        END IF
        IF(ICPC .EQ. PC25)THEN
          IF(OPTN(D05P25))THEN
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD5
              LLD(2,5)=LD56
              NLD(5)=2
            ELSE
              LLD(1,5)=LD5
              NLD(5)=1
            END IF
          ELSE
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD56
              NLD(5)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(5,IRPHAS,ICLD)
        NLD(6)=1
        IF(ICPC .EQ. PC37)THEN
          LLD(2,6)=LD56
          NLD(6)=2
        END IF
C=      CALL LDCSH(6,IRPHAS,ICLD)
      END IF
C
C-----FIGURE 6 PROCESS NEW PHASE COMBINATION (END)
C
C
C-----FIGURE 7 PROCESS NEW PHASE COMBINATION (START)
C
      IF(FIG7)THEN
C-----FIGURE 7 NOTE 3 OPTION A = OFF SIMGAP (START)
        IF((ICPC.EQ.PC15) .AND. (.NOT. OPTN(F7OPTA)))THEN
          HOLD(1)=.TRUE.
          HOLD(5)=.TRUE.
          STATE(PC15)=.TRUE.
        END IF
        IF((ICPC.EQ.PC16) .AND.
     *     (.NOT. OPTN(F7OPTA)) .AND.
     *     (TMRSET(F7P16L).GT.0.0D0)) CLPH(3)=.TRUE.
C-----FIGURE 7 NOTE 4 D2A (START)
        IF((ICPC.EQ.PC25) .AND. OPTN(F7OPTC))THEN
          IF(CLPH(6) .AND. (.NOT. CLPH(1)))TMRVAL(P2TG)=TMRSET(P2TG)
        END IF
C-----FIGURE 7 NOTE 4 D2A (END)
        IF(ICPC.NE.PC25)THEN
          TMRVAL(P2TG)=0.0D0
          LLD(1,2)=LD2
C=        CALL LDCSH(2,IRPHAS,ICLD)
        END IF
        STATE(PC26)=.FALSE.
        IF(ICPC .EQ. PC26)STATE(PC26)=.TRUE.
C-----FIGURE 7 NOTE 3 OPTION B = OFF (START)
        STATE(PC27)=.FALSE.
        IF((ICPC.EQ.PC27) .AND. (.NOT. OPTN(F7OPTB)))THEN
          TMRVAL(F7P27G)=TMRSET(F7P27G)
          HOLD(2)=.TRUE.
          HOLD(7)=.TRUE.
          STATE(PC27)=.TRUE.
        END IF
C-----FIGURE 7 NOTE 3 OPTION C = OFF (START)
        STATE(PC35)=.FALSE.
        IF(ICPC .EQ. PC35)THEN
          TMRVAL(F4P35G)=TMRSET(F4P35G)
          HOLD(3)=.TRUE.
          HOLD(5)=.TRUE.
          STATE(PC35)=.TRUE.
        END IF
C-----FIGURE 7 NOTE 4 D7A (START)
        IF(ICPC .EQ. PC37)TMRVAL(P7TG)=TMRSET(P7TG)
C-----FIGURE 7 NOTE 4 D7A (END)
        IF(ICPC .NE. PC37)THEN
          TMRVAL(P7TG)=0.0D0
          LLD(1,7)=LD7
C=        CALL LDCSH(7,IRPHAS,ICLD)
        END IF
C-----FIGURE 7 NOTE 4 D3 & D13 & D5 & D56
C-----  PHASE   D3  D13   D5  D56
C-----   1-5   YES       YES  YES
C-----   1-6   YES       YES
C-----   1-7   YES       YES
C-----   2-5   YES  PH1  OPT  OPT
C-----   2-6   YES       YES
C-----   2-7   YES       YES
C-----   3-5   YES  YES  YES  YES
C-----   3-6   YES  YES  YES
C-----   3-7   OPT  OPT  YES  PH6
C-----FIGURE 7 NOTE 4 D3 & D13
        NLD(3)=0
        IF((ICPC.EQ.PC15) .OR. (ICPC.EQ.PC16) .OR.
     *     (ICPC.EQ.PC17) .OR. (ICPC.EQ.PC25) .OR.
     *     (ICPC.EQ.PC26) .OR. (ICPC.EQ.PC27))THEN
          LLD(1,3)=LD3
          NLD(3)=1
        END IF
        IF((ICPC.EQ.PC35) .OR. (ICPC.EQ.PC36))THEN
          LLD(1,3)=LD3
          LLD(2,3)=LD13
          NLD(3)=2
        END IF
        IF(ICPC .EQ. PC37)THEN
          IF(OPTN(D03P37))THEN
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD3
              LLD(2,3)=LD13
              NLD(3)=2
            ELSE
              LLD(1,3)=LD3
              NLD(3)=1
            END IF
          ELSE
            IF(OPTN(D13P37))THEN
              LLD(1,3)=LD13
              NLD(3)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(3,IRPHAS,ICLD)
        NLD(1)=1
        IF(ICPC .EQ. PC25)THEN
          LLD(2,1)=LD13
          NLD(1)=2
        END IF
C=      CALL LDCSH(1,IRPHAS,ICLD)
C-----FIGURE 7 NOTE 4 D5 & D56
        NLD(5)=0
        IF((ICPC.EQ.PC16) .OR. (ICPC.EQ.PC17) .OR.
     *     (ICPC.EQ.PC26) .OR. (ICPC.EQ.PC27) .OR.
     *     (ICPC.EQ.PC36) .OR. (ICPC.EQ.PC37))THEN
          LLD(1,5)=LD5
          NLD(5)=1
        END IF
        IF((ICPC.EQ.PC15) .OR. (ICPC.EQ.PC35))THEN
          LLD(1,5)=LD5
          LLD(2,5)=LD56
          NLD(5)=2
        END IF
        IF(ICPC .EQ. PC25)THEN
          IF(OPTN(D05P25))THEN
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD5
              LLD(2,5)=LD56
              NLD(5)=2
            ELSE
              LLD(1,5)=LD5
              NLD(5)=1
            END IF
          ELSE
            IF(OPTN(D56P25))THEN
              LLD(1,5)=LD56
              NLD(5)=1
            END IF
          END IF
        END IF
C=      CALL LDCSH(5,IRPHAS,ICLD)
        NLD(6)=1
        IF(ICPC .EQ. PC37)THEN
          LLD(2,6)=LD56
          NLD(6)=2
        END IF
C=      CALL LDCSH(6,IRPHAS,ICLD)
      END IF
C
C-----FIGURE 7 PROCESS NEW PHASE COMBINATION (END)
C
C
C-----PROCESS NEW PHASE COMBINATION FOR ALL FIGURES (END)
C
 8020 CONTINUE
C
C-----PROCESS MULTIPLE RING SIGNAL (END)
C
C-----SAVE TRAFFIC DETECTOR ACTUATIONS FOR ANIMATION
C-----SET ALL DETECTORS TO FALSE
                    IF ( NLOOPS . LE . 0 )       GO TO 8040
      DO 8030  I = 1 , NLOOPS
      II=LLOOPS(I)
      CALL  PRE1LD  ( II )
      LDCROS(II) = .FALSE.
      LDTRIP(II) = .FALSE.
      LDCLER(II) = .FALSE.
      VDCNT (II) = .FALSE.
 8030 CONTINUE
 8040 CONTINUE
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9280 CONTINUE
      CALL  ABORTR  ( 'STOP 928 - ' //
     *                'FIG3, FIG4, FIG6, OR FIG7 NOT .TRUE. - ' //
     *                'TX3467'                                     )
      STOP  928
 9320 CONTINUE
      CALL  ABORTR  ( 'STOP 932 - ' //
     *                'CURRENT PHASE COMBINATION NOT ON IPH - ' //
     *                'TX3467'                                     )
      STOP  932
      END                                                               TX3467
C
C
C
      SUBROUTINE TX3DS1
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
C=    INCLUDE 'TESTER'
      INCLUDE 'USER'
C=    INTEGER           I
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'TX3DS1'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    IPGZ=1
C=    IRMAX=23
C=    CALL INITRM
C=    CALL ACTPG (IPGZ)
C=    CALL CLRSCR(IRMAX)
C=    IRADD=IRMAX+1-((NLOOPS+5)/6)
C=   *             -(1+NPHASE)
C=   *             -1
C=   *             -((NIBL+17)/18)
C=   *             -1
C=   *             -3
C=   *             -2
C=   *             -(1+NRING)
C=    IRDTCT=0
C=    IRPHAS=IRDTCT+((NLOOPS+5)/6)+1
C=    IF(IRADD .GE. 01)IRPHAS=IRPHAS+1
C=    IF(IRADD .GE. 07)IRPHAS=IRPHAS+1
C=    IRSTAT=IRPHAS+NPHASE
C=    IF(IRADD .GE. 02)IRSTAT=IRSTAT+1
C=    IF(IRADD .GE. 08)IRSTAT=IRSTAT+1
C=    IRSIGS=IRSTAT+1
C=    IF(IRADD .GE. 06)IRSIGS=IRSIGS+1
C=    IF(IRADD .GE. 12)IRSIGS=IRSIGS+1
C=    IROVLP=IRSIGS+((NIBL+17)/18)
C=    IRTMRS=IROVLP+1
C=    IF(IRADD .GE. 04)IRTMRS=IRTMRS+1
C=    IF(IRADD .GE. 10)IRTMRS=IRTMRS+1
C=    IROPTS=IRTMRS+3
C=    IF(IRADD .GE. 05)IROPTS=IROPTS+1
C=    IF(IRADD .GE. 11)IROPTS=IROPTS+1
C=    IRRING=IROPTS+2
C=    IF(IRADD .GE. 03)IRRING=IRRING+1
C=    IF(IRADD .GE. 09)IRRING=IRRING+1
C=    IRTIME=IRMAX
C=    ICRN=0
C=    ICPH=ICRN+2
C=    ICCA=ICPH+2
C=    ICNX=ICCA+5
C=    ICHO=ICNX+5
C=    ICSE=ICHO+5
C=    ICII=ICSE+4
C=    ICVI=ICII+5
C=    ICMX=ICVI+5
C=    ICCI=ICMX+6
C=    ICAR=ICCI+5
C=    ICLD=ICAR+5
C=    LDTXT( 1) = 'D1 '
C=    LDTXT( 2) = 'D2 '
C=    LDTXT( 3) = 'D2A'
C=    LDTXT( 4) = 'D3 '
C=    LDTXT( 5) = 'D13'
C=    LDTXT( 6) = 'D5 '
C=    LDTXT( 7) = 'D56'
C=    LDTXT( 8) = 'D6 '
C=    LDTXT( 9) = 'D7 '
C=    LDTXT(10) = 'D7A'
      RETURN
      END                                                               TX3DS1
C
C
C
      SUBROUTINE TX3DS2
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C=    CHARACTER*5       TMRNAM(NTM)
C=    CHARACTER*6       OPTNAM(NOP)
C=    INTEGER           I,IC,II,M
C=    DATA     (OPTNAM(I),I=01,03) / 'D03P37','D13P37','D05P25' /
C=    DATA     (OPTNAM(I),I=04,06) / 'D56P25','TLP27H','TLP27O' /
C=    DATA     (OPTNAM(I),I=07,09) / 'F6OPTA','F6OPTB','F6OPTC' /
C=    DATA     (OPTNAM(I),I=10,12) / 'F7OPTA','F7OPTB','F7OPTC' /
C=    DATA     (TMRNAM(I),I=01,04) / '4P35G' ,'P17AG' ,'P26AG' ,' P2TG'/
C=    DATA     (TMRNAM(I),I=05,08) / ' P7TG' ,'6P16L' ,'6P16H' ,'6P27G'/
C=    DATA     (TMRNAM(I),I=09,12) / '7P16L' ,'7P16H' ,'7P27G' ,'3P35G'/
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'TX3DS2'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    M=7
C=    CALL DINCH('STATES:',M,IRSTAT,0,IPGZ)
C=    CALL DINCH('SIGNAL:',M,IRSIGS,0,IPGZ)
C=    CALL DINCH('OVRLPS:',M,IROVLP,0,IPGZ)
C=    NLINE='TIMERS:'
C=    WRITE (NLINE(9:80),'(12(A5,1X))') (TMRNAM(I),I=1,NTM)
C=    CALL DINCH(NLINE(1:80),7,IRTMRS,0,IPGZ)
C=    NLINE='   SET:'
C=    WRITE (NLINE(8:80),'(12F6.1)') (TMRSET(I),I=1,NTM)
C=    CALL DINCH(NLINE(1:80),7,IRTMRS+1,0,IPGZ)
C=    TMRVAT( 1)=TMRVAL( 1)
C=    TMRVAT( 2)=TMRVAL( 2)
C=    TMRVAT( 3)=TMRVAL( 3)
C=    TMRVAT( 4)=TMRVAL( 4)
C=    TMRVAT( 5)=TMRVAL( 5)
C=    TMRVAT( 6)=TMRVAL( 6)
C=    TMRVAT( 7)=TMRVAL( 7)
C=    TMRVAT( 8)=TMRVAL( 8)
C=    TMRVAT( 9)=TMRVAL( 9)
C=    TMRVAT(10)=TMRVAL(10)
C=    TMRVAT(11)=TMRVAL(11)
C=    TMRVAT(12)=TMRVAL(12)
C=    NLINE='   VAL:'
C=    WRITE (NLINE(8:80),'(12F6.1)') (TMRVAL(I),I=1,NTM)
C=    CALL DINCH(NLINE(1:80),7,IRTMRS+2,0,IPGZ)
C=    CALL DINCH('OPTIONS:',7,IROPTS,0,IPGZ)
C=    IRADD=0
C=    IC=9
C=    DO 7 I=1,NOP
C=    IF(I.EQ.7)THEN
C=      IRADD=IRADD+1
C=      IC=9
C=    END IF
C=    IF(OPTN(I))THEN
C=      M=15
C=    ELSE
C=      M=7
C=    END IF
C=    CALL DINCH(OPTNAM(I),M,IROPTS+IRADD,IC,IPGZ)
C=    IC=IC+7
C=  7 CONTINUE
C=    IRADD=0
C=    DO 8 I=1,NRING
C=    WRITE (NLINE(1:1),'(I1)') I
C=    CALL DINCH(NLINE(1:1),7,IRPHAS+IRADD,ICRN,IPGZ)
C=    IRADD=IRADD+NPHPR(I)
C=  8 CONTINUE
C=    NLINE( 1:40)='R P CALL NEXT HOLD SEL  TII  TVI   TMX  '
C=    NLINE(41:80)='TCI  TAR  L1 L2 L3 L4 L5 L6 L7 L8 L9 10 '
C=    CALL DINCH(NLINE(1:80),7,IRPHAS-1,0,IPGZ)
C=    DO 9 I=1,NPHASE
C=    II=LPHASE(I)
C=    WRITE (NLINE(1:1),'(I1)') II
C=    CALL DINCH(NLINE(1:1),7,IRPHAS+I-1,ICPH,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TII(II)
C=    CALL DINCH(NLINE(1:4),7,IRPHAS+I-1,ICII,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TVI(II)
C=    CALL DINCH(NLINE(1:4),7,IRPHAS+I-1,ICVI,IPGZ)
C=    WRITE (NLINE(1:5),'(F5.1)') TMX(II)
C=    CALL DINCH(NLINE(1:5),7,IRPHAS+I-1,ICMX,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TCI(II)
C=    CALL DINCH(NLINE(1:4),7,IRPHAS+I-1,ICCI,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TAR(II)
C=    CALL DINCH(NLINE(1:4),7,IRPHAS+I-1,ICAR,IPGZ)
C=  9 CONTINUE
C=    NLINE(1:1)=' '
C=    CALL DINCH('RING  EOM PH IN   TP     TR',7,IRRING,0,IPGZ)
C=    CALL DINCH('IOPC  ICPC  INPC',7,IRRING,42,IPGZ)
C=    CALL DINCH('TIME: ',7,IRTIME,67,IPGZ)
      RETURN
      END                                                               TX3DS2
C
C
C
      SUBROUTINE TX3DS3
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C=    INTEGER           I,IC,II,IR,IRING,J,JJ,M
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'TX3DS3'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    DO 12 J=1,NLOOPS
C=    CALL LDSH(J)
C= 12 CONTINUE
C=    DO 14 J=1,NPHASE
C=    JJ=LPHASE(J)
C=    CALL CASH (CLPH,JJ,IRPHAS,ICCA)
C=    CALL NXSH (NEXT,JJ,IRPHAS,ICNX)
C=    CALL HOSH (HOLD,JJ,IRPHAS,ICHO)
C=    CALL SESH (SEL ,JJ,IRPHAS,ICSE)
C=    CALL LDCSH(     JJ,IRPHAS,ICLD)
C= 14 CONTINUE
C=    DO 16 IRING=1,NRING
C=    WRITE (NLINE(1:29),'(I3,1X,F5.2,2I3,2F7.2)',ERR=15)
C=   *IRING,EOM(IRING),ICPHAT(IRING),INTER(IRING),TPT(IRING),TRT(IRING)
C= 15 CONTINUE
C=    M=10
C=    IF(INTER(IRING).EQ.2)M=14
C=    IF(INTER(IRING).EQ.3)M=12
C=    CALL DINCH(NLINE(1:29),M,IRRING+IRING,0,IPGZ)
C= 16 CONTINUE
C=    IF(IOPC.NE.IOPCT)THEN
C=      IOPCT=IOPC
C=      WRITE (NLINE(1:6),'(I6)') IOPC
C=      CALL DINCH(NLINE(1:6),7,IRRING+1,39,IPGZ)
C=    END IF
C=    IF(ICPC.NE.ICPCT)THEN
C=      ICPCT=ICPC
C=      WRITE (NLINE(1:6),'(I6)') ICPC
C=      CALL DINCH(NLINE(1:6),7,IRRING+1,45,IPGZ)
C=    END IF
C=    IF(INPC.NE.INPCT)THEN
C=      INPCT=INPC
C=      WRITE (NLINE(1:6),'(I6)') INPC
C=      CALL DINCH(NLINE(1:6),7,IRRING+1,51,IPGZ)
C=    END IF
C=    IC=8
C=    DO 17 I=1,NPC
C=    IF(STATET(I) .NEQV. STATE(I))THEN
C=      STATET(I)=STATE(I)
C=      IF(STATE(I))THEN
C=        M=15
C=      ELSE
C=        M=7
C=      END IF
C=      CALL DINCH(STANAM(I),M,IRSTAT,IC,IPGZ)
C=    END IF
C=    IC=IC+7
C= 17 CONTINUE
C=    DO 18 I=1,NOLP
C=    M=7
C=    IF(IOVRLP(I).EQ.1)M=10
C=    IF(IOVRLP(I).EQ.2)M=14
C=    IF(IOVRLT(I).NE.M)THEN
C=      IOVRLT(I)=M
C=      II=ICAMPH(LOLP(I))
C=      IC=8+(I-1)*4
C=      CALL DINCH('OL'//CHAR( ICHAR( 'A' )-1+II ),M,IROVLP,IC,IPGZ)
C=    END IF
C= 18 CONTINUE
C=    DO 19 I=1,NTM
C=    IF(TMRVAT(I) .NE. TMRVAL(I))THEN
C=      TMRVAT(I)=TMRVAL(I)
C=      WRITE (NLINE(1:6),'(F6.1)') TMRVAL(I)
C=      IF(TMRVAL(I) .GT. 0.0D0)THEN
C=        M=15
C=      ELSE
C=        M=7
C=      END IF
C=      CALL DINCH(NLINE(1:6),M,IRTMRS+2,7+(I-1)*6,IPGZ)
C=    END IF
C= 19 CONTINUE
C=    WRITE (NLINE(1:7),'(F7.2)') TIME
C=    CALL DINCH(NLINE(1:7),15,IRTIME,73,IPGZ)
C=    CALL LTRP(IRDTCT,8,IRSIGS)
      RETURN
      END                                                               TX3DS3
C
C
C
      SUBROUTINE NEMA
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      LOGICAL           CLPHMX(NPN),CROSED(NRG),CROSNG,DFP(NPN),NEWCSP,
     *                  NEWPH(NRG),PDHOLD(NRG),PDCALT,PEDCYC(NRG),
     *                  PREEMP,RRHOLD(NRG),SERVED(NRG),SINGLE
      INTEGER           I,IG,IGROUP,IGROUT,II,ILD,INCPCT,IPCLTO,IR,IR1,
     *                  J,JLD,JP,NPCLTO,NXTGRP
C     INTEGER           IPREEM(0:NRG)                                   RFI
      DOUBLE PRECISION  DTD10,DTD4,PEDTEC(NRG),PEDTEW(NRG),TRL
      SAVE              CLPHMX,CROSED,CROSNG,DFP,DTD10,DTD4,IGROUP,
     *                  IGROUT,NEWCSP,NEWPH,NXTGRP,PDHOLD,PEDCYC,PEDTEC,
     *                  PEDTEW,PREEMP,RRHOLD,SERVED
      DATA     CLPHMX / NPN*.FALSE. /
      DATA     PDHOLD / NRG*.FALSE. /
      DATA     PEDCYC / NRG*.FALSE. /
      DATA     PEDTEC / NRG* 0.0D0  /
      DATA     PEDTEW / NRG* 0.0D0  /
      DATA     RRHOLD / NRG*.FALSE. /
C
C-----HOLD(PHASE)         - IS PHASE HELD IN CURRENT INTERVAL
C-----NLD(PHASE)          - NUMBER OF LOOP DETECTORS CONNECTED TO PHASE
C-----LLD(I,PHASE)        - LIST OF LOOP DETECTORS CONNECTED TO PHASE
C-----CROSNG              - IS BARRIER CROSSING INITIATED
C-----CLPH(PHASE)         - IS THERE A CALL FOR THE PHASE
C-----ICPHAT(RING)        - CURRENT PHASE
C-----ICAMCT(RING)        -
C-----ICAMPS(PHASE)       -
c-----SEL(PHASE)          - PHASE HAS BEEN SERVED AND HAS NO CURRENT
C-----                      DEMAND
C-----DAB                 - IS THERE A CALL (BY DET, MIN OR MAX RECALL,
C-----                      ETC.) FOR PHASE NOT IN THE CURRENT GROUP
C-----INTER(RING)         - INTERVAL (GREEN, YELLOW, RED)
C-----NEXTTT(RING)        - PRELIMINARY NEXT PHASE (-1 CURRENTLY NO
C-----                      PRELIM NEXT PHASE)
C-----NEXTPT(RING)        - TEMPORARY MEMORY FOR NEXTPH
C-----SERVED(RING)        - HAS RING BEEN SERVED
C-----NPHPS(RING,GROUP)   - NUMBER OF PHASES IN PREFERRED SEQUENCE
C-----LPHPS(RING,GROUP,I) - LIST OF PHASES IN PREFERRED SEQUENCE
C-----IPHPS(RING)         - INDEX OF CHOSEN PHASE IN PREFERRED SEQUENCE
C-----DFP(PHASE)          - HAS A DETECTOR FOR A PHASE HAS BEEN TRIPPED
C-----CLPH(PHASE)         - IS THERE A CALL (BY DET, MIN OR MAX RECALL,
C-----                      ETC.) FOR PHASE
C-----IDOR(RING,GROUP)    - IS THERE A DETECTOR CALL FOR A NON GREEN
C-----                      PHASE IN CURRENT RING AND GROUP
c-----IGROUP              - CURRENT GROUP
C-----IGROUT              - POTENTIAL NEXT GROUP ACROSS BARRIER
C-----NXTGRP              - FIRST GROUP ACROSS BARRIER(S) TO HAVE DEMAND
C-----TIMRCR(PHASE)       - USED TO INSURE THAT ALL CLEARANCES
C                           END SIMULTANEOUSLY WHEN CROSSING BARRIER
C-----SINGLE              - IS THIS A SINGLE RING CONTROLLER
C-----PEDCYC(RING)        - WAS THERE A PED CYCLE AT START OF THIS PHASE
C-----PEDINT              - PEDESTRIAN INTERVAL 0 NO PEDS THIS PHASE
C                                               1 DON'T WALK
C                                               2 WALK
C                                               3 FLASHING DON'T WALK
C-----PEDTEW              - TIME TO END PEDESTRIAN WALK
C-----PEDTEC              - TIME TO END PEDESTRIAN CLEARANCE
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'NEMA'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C-----START OF CODE FOR TESTING - FIRST TIME ONLY CODE
      IF(FIRSIG)THEN
C       IPREEM(0) = 0                                                   RFI
        FIRSIG=.FALSE.
        DTD4  = DT /  4.0D0
        DTD10 = DT / 10.0D0
C=      CALL NEMDS1
C
C-----  (RING,GROUP)
C-----  GROUPS ARE SEPARATED BY BARRIERS
C
C-----  INITIALIZATION (START)
C
        SINGLE = (NRING .EQ. 1) .AND. (NGROUP .EQ. 1)
        PREEMP = .FALSE.
        NXTGRP = 0
        CROSNG = .FALSE.
        DO 45 J = 1, NPHASE
        JP = LPHASE(J)
        IF ( PEDVOL(JP) . GT . 0 ) PDSTAT(JP) = -1
        IF ( PEDS(JP) )                          THEN
C
C----- SET PHASES WITH PEDS TO DON'T WALK
C
          PEDINT(JP) = INTERR
        END IF
C-----  CAUSE WRITE AT TIME 0.0
        NEWPSI = ANYPED
        IF (IPRCL(JP) .EQ. IYES) PDCALL(JP) = .TRUE.
        IF ( PDTRIP(JP) )        PDCALL(JP) = .TRUE.
        CLPH(JP) = PDCALL(JP)
        TMX(JP) = TM1(JP)
        IF ( T2S(JP) . GT . 0.0D0 )              THEN
          T2S(JP) = 60.0D0*T2S(JP)
        ELSE
          T2S(JP) = 0.0D0
        END IF
        IF ( IMNR(JP) .EQ. IYES ) CLPH(JP) = .TRUE.
        IF ( IMXR(JP) .EQ. IYES ) CLPH(JP) = .TRUE.
   45   CONTINUE
        IGROUP = 1
   49   CONTINUE
        DO 50 IRING = 1, NRING
C
C-----  SELECT FIRST PHASE IN PREFERRED SEQUENCE LIST
C
        IF ( NPHPS(IRING,IGROUP) .GT. 0 )        THEN
          SERVED(IRING) = .FALSE.
          IPHPS(IRING) = 1
          JP = LPHPS(IRING,IGROUP,1)
          ICAMCT(IRING) = ICAMPS(JP)
          ICPHAT(IRING) = JP
          TRT(IRING) = TMI(JP)
          TRLAST(IRING)=TVI(JP)
          IF ( IMNR(JP) .EQ. IYES ) CLPH(JP) = .FALSE.
          IF ( IMXR(JP) .EQ. IYES )              THEN
            EOM(IRING) = DMAX1( TMX(JP),TMI(JP) )
            CLPH(JP) = .TRUE.
            TVIBEG(JP) = TVITBR(JP)
          ELSE
            TVIBEG(JP) = TIMERR
          END IF
          IF (PDCALL(JP))                        THEN
            PDCALL(JP) = .FALSE.
            PEDINT(JP) = INTERG
            PDHOLD(IRING) = .TRUE.
            PEDTEW(IRING) = TWK(JP)
            PEDTEC(IRING) = TWK(JP) + TPC(JP)
            PEDCYC(IRING) = .TRUE.
            NEWPSI = .TRUE.
            IF (PDEXCL(JP))                      THEN
C----- DON'T TIME GREEN
              EOM(IRING) = 0.0D0
              TRT(IRING) = 0.0D0
              TR = 0.0D0
            END IF
          END IF
        ELSE
          SERVED(IRING) = .TRUE.
          IPHPS(IRING) = 0
          ICAMCT(IRING) = 0
          ICPHAT(IRING) = 0
          TRT(IRING) = 0.0D0
          TRLAST(IRING) = 0.0D0
        END IF
        INTER(IRING) = 1
        NEXTTT(IRING) = -1
        TPT(IRING) = 0.0D0
   50   CONTINUE
        IF (IGROUP .EQ. 1)                       THEN
          DO  IRING = 1, NRING
            JP = ICPHAT(IRING)
            IF (JP .EQ. 0 )CYCLE
            IF (.NOT.PDEXCL(JP))                           GO TO 70
            IF (PDCALL(JP))                                GO TO 70
          END DO
C
C----- CHOSEN PHASE(S) IN GROUP 1 HAVE ONLY EXCL PED WITHOUT RECALL ON
C
          IF (NGROUP .GT. 1)                     THEN
            IGROUP = 2
                                                           GO TO 49
          END IF
   70     CONTINUE
        END IF
        CALL MAKECS (ICAMCT(1),ICAMCT(2),ICAMPC)
        DO 100 I = 3, NRING
        CALL MAKECS (ICAMPC,ICAMCT(I),ICAMPC)
  100   CONTINUE
        CALL OVLP
C
C-----  INITIALIZATION (END)
C
C=      CALL NEMDS2 ( CROSNG,SERVED )
                                                           GO TO 7010
      END IF
C-----END OF CODE FOR TESTING - FIRST TIME ONLY CODE
      CALL  LDDLEX
      IF ( ANYPED ) CALL PREPPD
C-----COUNT THE NUMBER OF VEHICLE ACTUATIONS DURING THE YELLOW AND RED
C-----INTERVALS OF A PHASE.  A COUNT OCCURS FOR A DETECTOR WHEN A
C-----VEHICLE'S FRONT BUMPER CROSSES THE BEGINNING OF THE DETECTOR IN
C-----EITHER PULSE OR PRESENCE MODE AND THE DETECTOR IS NOT TRIPPED BY
C-----ANOTHER VEHICLE IN ANY LANE COVERED BY THE DETECTOR.  THE
C-----DETECTOR IS ASSUMED TO RESET EACH DT THUS AT MOST ONE VEHICLE CAN
C-----BE COUNTED BY ANY ONE DETECTOR EACH DT
      DO 123 IRING = 1 , NRING
      ICPHAS = ICPHAT(IRING)
      DO 122 IG = 1 , NGROUP
      DO 121 II = 1 , NPHPS(IRING,IG)
      JP = LPHPS(IRING,IG,II)
                    IF ( NLD(JP) . EQ . 0 )                GO TO 121
      DO 120 ILD = 1 , NLD(JP)
      JLD = LLD(ILD,JP)
      IF ( VDCNT(JLD) )                          THEN
C-----VOLUME DENSITY - ONLY COUNT WHEN LOOP IS NOT OCCUPIED WHEN CROSSED
        VDCNT(JLD) = .FALSE.
        IF ((JP .EQ. ICPHAS) .AND. (INTER(IRING) .EQ. 1))  GO TO 120
        TIIVEH(JP) = TIIVEH(JP) + 1.0D0
      END IF
  120 CONTINUE
  121 CONTINUE
  122 CONTINUE
  123 CONTINUE
      DO  J = 1, NPHASE
        JP =  LPHASE(J)
        IF ((T2S(JP).GT.0.0D0).AND.(TIME .GE. T2S(JP))) THEN
          TMX(JP) = TM2(JP)
        END IF
      END DO
C=    CALL NEMDS3 ( CROSNG,SERVED,IGROUP )
C
C-----PROCESS MULTIPLE RING SIGNAL (START)
C
C     CALL PREMPT (IPREEM,TIME)                                         RFI
      NEWCSP=.FALSE.
      ICAMPO=ICAMPC
      IF(CROSNG)                                 THEN
C-----SYNCRONIZE START OF YELLOWS SO THAT ALL PHASES END AT SAME TIME
C-----DON'T START TILL ALL TIMERS HAVE BEEN INITIALIZED
        DO 200 IRING=1,NRING
        JP=ICPHAT(IRING)
        IF(JP.EQ.0)                                        GO TO  200
        IF(TIMRCR(JP).EQ.-9.99D0)                          GO TO  215
  200   CONTINUE
        DO 210 IRING=1,NRING
        JP=ICPHAT(IRING)
        IF(JP.EQ.0)                                        GO TO  210
        IF(TIMRCR(JP) .GT. DTD10)                THEN
          TIMRCR(JP)=TIMRCR(JP)-DT
          IF(TIMRCR(JP) .LE. DTD10)              THEN
            TIMRCR(JP)=0.0D0
            HOLD(JP)=.FALSE.
          END IF
        END IF
  210   CONTINUE
  215   CONTINUE
      END IF
      DO 220 IRING=1,NRING
      TPT(IRING) = TPT(IRING) + DT
      TRT(IRING) = TRT(IRING) - DT
                    IF ( TRT(IRING).LT.0.5D0*DT )TRT(IRING) = 0.0D0
      NEWPH(IRING)=.FALSE.
  220 CONTINUE
C=    CALL LTRP(IRDTCT,8,IRSIGS)
C     IF ((IPREEM(0) .EQ. 0) .AND. PREEMP)       THEN                   RFI
C-----  TERMINATE PREEMPTION (START)
C       PREEMP = .FALSE.                                                RFI
C       DO IRING = 1,NRING                                              RFI
C       HOLD(ICPHAT(IRING)) = .FALSE.                                   RFI
C       END DO                                                          RFI
C-----  TERMINATE PREEMPTION (END)
C     END IF                                                            RFI
C     IF ((IPREEM(0) .GT. 0) .AND. (.NOT.PREEMP))THEN                   RFI
C-----  INITIATE PREEMPTION (START)
C       PREEMP = .TRUE.                                                 RFI
C-----  PREPARE TIMERS TO MAKE SURE THAT ALL PHASES END AT THE SAME TIME
C-----  INSURE MIN GREEN IS MET
C       CALL TIMRS1                                                     RFI
C       IF (IPREEM(0) .EQ. IGROUP)               THEN                   RFI
C         DO 237 IR = 1, NRING                                          RFI
C         IF(IPREEM(IR) .GT. 0)                  THEN                   RFI
C           IF(ICPHAT(IR) .EQ. IPREEM(IR))       THEN                   RFI
C-----        PREEMPTING PHASE IS AN ACTIVE PHASE,
C             IF (INTER(IR) .EQ.1)               THEN                   RFI
C-----          GREEN, KEEP IT ACTIVE
C               HOLD(ICPHAT(IR)) = .TRUE.                               RFI
C             ELSE                                                      RFI
C-----          IN CLEARANCE, PREPARE TO RECALL SAME PHASE
C               NEXTTT(IR) = IPREEM(IR)                                 RFI
C               NEXTPT(IR) = IPREEM(IR)                                 RFI
C               IF (ICPHAT(IR) .GT.0) SEL(ICPHAT(IR)) = .TRUE.          RFI
C               HOLD(NEXTTT(IR)) = .TRUE.                               RFI
C               CROSNG = .FALSE.                                        RFI
C             END IF                                                    RFI
C           ELSE                                                        RFI
C-----        PREEMPTING TO AN INACTIVE PHASE
C             NEXTTT(IR) = IPREEM(IR)                                   RFI
C             NEXTPT(IR) = IPREEM(IR)                                   RFI
C             IF (ICPHAT(IR) .GT.0) SEL(ICPHAT(IR)) = .TRUE.            RFI
C             HOLD(NEXTTT(IR)) = .TRUE.                                 RFI
C           END IF                                                      RFI
C         END IF                                                        RFI
C 237     CONTINUE                                                      RFI
C         GO TO 4700                                                    RFI
C       ELSE                                                            RFI
C-----    CROSSING BARRIER
C         CROSNG = .TRUE.                                               RFI
C         NXTGRP = IPREEM(0)                                            RFI
C         IGROUT = NXTGRP                                               RFI
C         DO 238 IR = 1, NRING                                          RFI
C         IF(IPREEM(IR) .GT. 0)                  THEN                   RFI
C           NEXTTT(IR) = IPREEM(IR)                                     RFI
C           NEXTPT(IR) = IPREEM(IR)                                     RFI
C         END IF                                                        RFI
C         HOLD(NEXTTT(IR)) = .TRUE.                                     RFI
C 238     CONTINUE                                                      RFI
C         DAB = .TRUE.                                                  RFI
C         DO 240 IR = 1, NRING                                          RFI
C-----    WILL BE USE TO RECORD WHEN EACH RING HAS CROSSED THE BARRIER
C         CROSED(IR) = .FALSE.                                          RFI
C 240     CONTINUE                                                      RFI
C         GO TO 1000                                                    RFI
C       END IF                                                          RFI
C 245   CONTINUE                                                        RFI
C-----INITIATE PREEMPTION (END)
C     END IF                                                            RFI
C
C-----CHECK DEMAND FOR PHASE (START)
C-----CHECK DEMAND ACROSS BARRIER (START)
C
      DAB=.FALSE.
      DO 320 IG=1,NGROUP
      DO 310 IRING=1,NRING
      ICPHAS=ICPHAT(IRING)
      DO 305 II=1,NPHPS(IRING,IG)
      JP=LPHPS(IRING,IG,II)
      IF(JP.EQ.0)                                          GO TO  305
      IF((ISTO(JP).NE.IYES) .AND. (IMNR(JP).NE.IYES) .AND.
     *   (.NOT. (CLPHMX(JP) .OR. PDCALL(JP))))             THEN
        CLPH(JP)=.FALSE.
      END IF
      PDCALT = PDCALL(JP)
      IF ((INTER(IRING) .EQ. 1) .AND. (IG .EQ.IGROUP))     THEN
C-----DURING ACTIVE PHASE GREEN, DON'T CONSIDER PED CALL AS DEMAND
        PDCALL(JP) = .FALSE.
      END IF
      CALL CHKDFP (DFP(JP),JP,1)
      PDCALL(JP) = PDCALT
      IF(IMXR(JP) .EQ. IYES)                               THEN
        DFP(JP)=.TRUE.
      END IF
C RFI       IF(IPRCL(JP).EQ.IYES)DFP(JP)=.TRUE.
      IF(.NOT. DFP(JP))                                    GO TO  300
      IF((JP.EQ.ICPHAS) .AND. (INTER(IRING).EQ.1))         GO TO  300
      CLPH(JP)=.TRUE.
  300 CONTINUE
      IF((IG.NE.IGROUP).AND.(CLPH(JP) .OR. PDCALL(JP)))    DAB=.TRUE.
  305 CONTINUE
  310 CONTINUE
  320 CONTINUE
C
C-----CHECK DEMAND FOR PHASE (END)
C
C=    IF(.NOT. CROSNG)                           THEN
C=      IF(DABT.NEQV.DAB)                        THEN
C=        DABT=DAB
C=        IF(DAB)                                THEN
C=          M=15
C=        ELSE
C=          M=7
C=        END IF
C=        CALL DINCH('DAB',M,IRTIME,51,IPGZ)
C=      END IF
C=    END IF
C-----CHECK DEMAND ACROSS BARRIER (END)
 1000 CONTINUE
      DO 4500 IRING=1,NRING
      ICPHAS=ICPHAT(IRING)
      TP=TPT(IRING)
      TR=TRT(IRING)
      IF(ICPHAS.GT.0)                            THEN
        IF((PEDINT(ICPHAS) .EQ. INTERG) .OR.
     *     (PEDINT(ICPHAS) .EQ. INTERY) )        THEN
C-----NOW TIMING PEDS
          IF(ABS(TIME-PEDTEW(IRING)).LT.DTD4)    THEN
C-----CHANGE PED TO FLASHING DON'T WALK
            PEDINT(ICPHAS) = INTERY
            PEDTEW(IRING) = 0.0D0
            NEWPSI = .TRUE.
          ELSE IF(ABS(TIME-PEDTEC(IRING)).LT.DTD4)THEN
C-----CHANGE PED TO DON'T WALK
            PEDINT(ICPHAS) = INTERR
            PEDTEC(IRING) = 0.0D0
            IF (PDEXCL(ICPHAS)) SEL(ICPHAS)=.TRUE.
            NEWPSI = .TRUE.
            PDHOLD(IRING) = .FALSE.
          END IF
        END IF
        IF((SEL(ICPHAS)  .OR. CROSNG) .AND.
     *     (HOLD(ICPHAS) .OR. PDHOLD(IRING)))    GO TO 4500
      END IF
C-----CHECK DEMAND ON RED (START)
      IF(.NOT. CROSNG)                           THEN
        DO 1020 I=1,NPHPS(IRING,IGROUP)
        JP=LPHPS(IRING,IGROUP,I)
        IF(JP.EQ.0)                                        GO TO 1020
        IF((ISTO(JP).NE.IYES) .AND.
     1     (IMNR(JP).NE.IYES)      )  IDOR(IRING,IGROUP) = .FALSE.
        IF(CLPH(JP).AND.IDOR(IRING,IGROUP))                GO TO 1020
        IF((JP.EQ.ICPHAS) .AND. (INTER(IRING).EQ.1))       GO TO 1020
        IF(CLPH(JP))                             THEN
          IDOR(IRING,IGROUP)=.TRUE.
          EXIT
        END IF
 1020   CONTINUE
      END IF
C-----CHECK DEMAND ON RED (END)
      IF(ICPHAS.EQ.0)                                      GO TO 2050
      IF(INTER(IRING).GT.1)                                GO TO 4500
      IF ((PEDINT(ICPHAS) .EQ. INTERR   ) .AND.
     *    (PDCALL(ICPHAS)               ) .AND.
     *    (IPRCY(ICPHAS)  .EQ. IYES     ) .AND.
     *    (.NOT. (IDOR(IRING,IGROUP) .OR. DAB))) THEN
C-----PREPARE TO TIME PEDESTRIAN RECYCLE
        PDCALL(ICPHAS) = .FALSE.
        PEDINT(ICPHAS) = INTERG
        NEWPSI = .TRUE.
        PDHOLD(IRING) = .TRUE.
        PDSTAT(JP) = TDNONE
        PEDTEW(IRING) = TIME + TWK(ICPHAS)
        PEDTEC(IRING) = PEDTEW(IRING) + TPC(ICPHAS)
      END IF
C-----CHECK DEMAND ON GREEN (START)
      IF ( CROSNG )                                        GO TO 2010
      IF (PDEXCL(ICPHAS))                                  GO TO 1200
C-----SIMULTANEOUS GAPOUT CHECKS (START)
      IF (ESIMGO .OR. SINGLE)                              GO TO 1100
      IF (.NOT.DAB)                                        GO TO 1100
C----- DON'T RESET GAP TIMER IF ALREADY GAPPED OUT
      IF (.NOT. SEL(ICPHAS))                               GO TO 1100
C-----CHECK FOR CONCURRENT PHASES
      J = 0
      DO I = 1, NRING
        IF (ICPHAT(I) .GT. 0)                    THEN
          IF ( J .EQ. 1)                                   GO TO 1050
          J = J + 1
        END IF
      END DO
C-----NOT TIMING CONCURRENT PHASES
      GO TO 1100
 1050 CONTINUE
C-----TIMING CONCURRENT PHASES
      DO I = 1, NRING
C-----CHECK FOR LAST PHASES IN PREFERRED SEQUENCE LISTS
        IF (ICPHAT(I) .NE. LPHPS(I,IGROUP,NPHPS(I,IGROUP)))GO TO 1100
      END DO
C-----ALL RINGS TIMING LAST PHASE IN PREFERRED SEQUENCE LIST
C-----SIMULTANEOUS GAPOUT CONDITIONS MET
      GO TO 1200
C-----SIMULTANEOUS GAPOUT CHECKS (END)
 1100 CONTINUE
      IF (DFP(ICPHAS).AND.(TP.GT.TII(ICPHAS)))   THEN
C-----RESET THE GAP TIMER BECAUSE OF DETECTOR ACTUATION ON THIS PHASE
        IF ( VOLDEN(ICPHAS)         . AND .
     *       (TP.GT.TVIBEG(ICPHAS)) )            THEN
          TR = TVI(ICPHAS) - (TP-TVIBEG(ICPHAS))*TVISLP(ICPHAS)
          TR = DMAX1( TR,TVIMIN(ICPHAS) )
        ELSE
          TR = TVI(ICPHAS)
        END IF
        TRT(IRING)=TR
        TRLAST(IRING)=TR
        SEL(ICPHAS)=.FALSE.
      END IF
 1200 CONTINUE
C-----SET MAX TIMERS
      IF (PDEXCL(ICPHAS))                        THEN
C----- DON'T TIME GREEN
        EOM(IRING) = 0.0D0
      ELSE
        IF ( IDOR(IRING,IGROUP) . OR . DAB )     THEN
          IF ( EOM(IRING) . EQ . TIMERR )        THEN
            EOM(IRING) = DMAX1( TP+TMX(ICPHAS),TMI(ICPHAS) )
          END IF
          IF ( TVIBEG(ICPHAS) . EQ . TIMERR )    THEN
            TVIBEG(ICPHAS) = TP + TVITBR(ICPHAS)
          END IF
        ELSE
          EOM(IRING) = TIMERR
          TVIBEG(ICPHAS) = TIMERR
        END IF
      END IF
      IF ( (EOM(IRING).NE.TIMERR ) . AND .
     *     (TR        .LE.0.0D0  ) )             THEN
        IF (.NOT.PDEXCL(ICPHAS))GMT(ICPHAS)='G'
                                                           GO TO 2010
      END IF
      IF ( TP .GE. EOM(IRING) )                  THEN
        IF ( IMXR(ICPHAS) .EQ. IYES )            THEN
C
C----- PLACEMENT OF MAXIMUM RECALL
C----- DON'T END PHASE TILL THERE IS DEMAND ELSEWHERE
C
          IF ( IDOR(IRING,IGROUP) .OR. DAB )     THEN
            IF (.NOT.PDEXCL(ICPHAS))GMT(ICPHAS) = 'M'
                                                           GO TO 2010
          END IF
        ELSE
          IF (.NOT.PDEXCL(ICPHAS))GMT(ICPHAS) = 'M'
                                                           GO TO 2010
        END IF
      END IF
      IF (TR .LT. TVI(ICPHAS))                             GO TO 4500
      IF (DFP(ICPHAS).AND.(IMXR(ICPHAS).NE.IYES))THEN
        CLPH(ICPHAS) = .FALSE.
      END IF
                                                           GO TO 4500
C-----CHECK DEMAND ON GREEN (END)
 2010 CONTINUE
C-----GAP-OUT, MAX-OUT
C rfi GAP-OUT, MAX-OUT, PREEMPT
      IF (.NOT. PDEXCL(ICPHAS))                  THEN
        SEL(ICPHAS)=.TRUE.
        CLPH(ICPHAS)=.FALSE.
      END IF
 2040 CONTINUE
      IF(HOLD  (ICPHAS) .OR. PDHOLD(IRING) .OR.
     *   RRHOLD(IRING)                         )          GO TO 4500
C-----CHOOSE NEXT PHASE (START)
 2050 CONTINUE
      IF(CROSNG)                                 THEN
C-----CHOOSE NEXT PHASE ACROSS BARRIER (START)
        IF (NEXTTT(IRING).GE. 0)                           GO TO 3540
        DO 3535 I = 1 , NPHPS(IRING,NXTGRP)
        JP = LPHPS(IRING,NXTGRP,I)
        IF ( CLPH(JP) )                          THEN
          NEXTTT(IRING) = JP
          IPHPS(IRING) = I
                                                           GO TO 3540
        END IF
 3535   CONTINUE
        NEXTTT(IRING) = 0
        IPHPS(IRING) = 0
 3540   CONTINUE
        IF(ICPHAS.GT.0)SEL(ICPHAS) = .FALSE.
C-----CHOOSE NEXT PHASE ACROSS BARRIER (END)
      ELSE
        IF ((.NOT. SERVED(IRING)).OR.(NGROUP .EQ. 1).OR.
     *      (.NOT. DAB))                         THEN
C-----CHOOSE NEXT PHASE BASED ON "PREFERRED SEQUENCE" LIST (START)
C-----FIRST CHECK FROM THE CURRENT PHASE TO THE END OF THE LIST
          NEXTPH = -1
          IPCLTO = IPHPS(IRING)+1
          NPCLTO = NPHPS(IRING,IGROUP)
          INCPCT = 1
          DO 4020  I = IPCLTO , NPCLTO , INCPCT
          NEXTPH = LPHPS(IRING,IGROUP,I)
          IF ( CLPH(NEXTPH) )                    THEN
            IPHPS(IRING) = I
            NEXTTT(IRING) = NEXTPH
            IF(ICPHAS.GT.0)SEL(ICPHAS) = .FALSE.
                                                           GO TO 4030
          END IF
 4020     CONTINUE
        END IF
C-----NO SERVICABLE DEMAND FOR PHS AHEAD OF THIS PHASE ON PRE SEQ LIST
        IF (NGROUP .EQ. 1 .OR. (.NOT. DAB))      THEN
C-----SINGLE RING SEQUENTIAL CONTROLLER OR NO DEMAND ACROSS BARRIER
C-----CHECK THE PHASES BEFORE THIS PHASE ON THE PREFERRED SEQ LIST
          IPCLTO = 1
          NPCLTO = IPHPS(IRING)-1
          INCPCT = 1
          DO I = IPCLTO , NPCLTO , INCPCT
            NEXTPH = LPHPS(IRING,IGROUP,I)
            IF (.NOT. CLPH(NEXTPH))                        CYCLE
            IPHPS(IRING) = I
            NEXTTT(IRING) = NEXTPH
            IF(ICPHAS.GT.0)SEL(ICPHAS) = .FALSE.
                                                           GO TO 4030
          END DO
        ELSE IF (ICPHAS .GT. 0)                  THEN
          IF (ICNDSV(ICPHAS) .EQ. IYES)          THEN
C-----NOT FOR SINGLE RING CONTROLLER
            IPCLTO = 1
            NPCLTO = IPHPS(IRING)-1
            INCPCT = 1
            DO I = IPCLTO , NPCLTO , INCPCT
              NEXTPH = LPHPS(IRING,IGROUP,I)
              IF (.NOT. CLPH(NEXTPH))                      CYCLE
              DO J = 1, NRING
C-----TS2 3.5.3.9.3
C-----IS THERE SUFFICIENT TIME REMAINING BEFORE MAX TIME OUT
C-----OF THE PHASE(S) NOT PREPARED TO TERMINATE
                IF (J.EQ.IRING)                            CYCLE
                IF (INTER(J).NE. 1)                        CYCLE
                IF ((TII(ICPHAS)+TVI(ICPHAS)).GE.(EOM(J)-TPT(J)))CYCLE
C-----SUFFICIENT TIME
                IPHPS(IRING) = I
                NEXTTT(IRING) = NEXTPH
                SEL(ICPHAS) = .FALSE.
                                                           GO TO 4030
              END DO
            END DO
          END IF
        END IF
C-----NO NEXT PHASE FOUND
        NEXTPH = -1
        NEXTTT(IRING)=-1
C-----CHOOSE NEXT PHASE BASED ON "PREFERRED SEQUENCE" LIST (END)
      END IF
 4030 CONTINUE
C-----CHOOSE NEXT PHASE (END)
 4500 CONTINUE
C-----CHECK DEMAND FOR PHASE (END)
      IF(PREEMP .OR.(.NOT.DAB))                            GO TO 4700
      DO 4505 IRING = 1 , NRING
      JP = ICPHAT(IRING)
      IF ( PDHOLD(IRING) .OR. RRHOLD(IRING))               GO TO 4700
      IF ((SERVED(IRING)        .AND.
     *     (INTER(IRING) .EQ. 1) .AND. (TRT(IRING).LE. 0. 0D0)) .OR.
     *     (SEL(JP)                                           ) .OR.
     *     (JP .EQ. 0                                         )) CYCLE
      GO TO 4700
 4505 CONTINUE
C-----NO RING TIMING PEDS AND
C-----ALL RINGS: HAVE BEEN SERVED & DON'T HAVE TIME REMAINING OR
C-----           ARE IN SELECT OR
C-----           DON'T HAVE AN ACTIVE PHASE
      IF ( (.NOT. CROSNG) )                      THEN
C-----INITIATE CROSSING BARRIER (START)
        CROSNG = .TRUE.
C----- FIND FIRST GROUP WITH DEMAND ACROSS BARRIER(S)
        IG=IGROUP
 4510   CONTINUE
        IG = IG + 1
        IF(IG.GT.NGROUP)IG = 1
        IF(IG .EQ. IGROUP)                                 GO TO 4525
        DO 4520 IRING=1,NRING
        DO 4515 II=1,NPHPS(IRING,IG)
        JP=LPHPS(IRING,IG,II)
        IF(JP.EQ.0)                                        GO TO 4515
        IF (CLPH(JP))                            THEN
          NXTGRP = IG
          IGROUT = IG
                                                           GO TO 4525
        END IF
 4515   CONTINUE
 4520   CONTINUE
                                                           GO TO 4510
 4525   CONTINUE
        DO 4530 IR = 1, NRING
C-----WILL BE USE TO RECORD WHEN EACH RING HAS CROSSED THE BARRIER
        CROSED(IR) = .FALSE.
 4530   CONTINUE
C----- PREPARE TIMERS TO MAKE SURE THAT ALL PHASES END AT THE SAME TIME
        CALL TIMRS1
C----- INITIATE CROSSING BARRIER (END)
      END IF
 4700 CONTINUE
C
C-----NEXTTT SET FOR ALL RINGS
C
C-----PROCESS EACH RING BY INTERVAL TYPE (START)
C
      DO 7000 IRING = 1, NRING
      ICPHAS = ICPHAT(IRING)
      IF ( CROSNG .AND.  (ICPHAS .EQ. 0) )       GO TO 7000
      GO TO ( 4900,5010,6010 ) , INTER(IRING)
 4900 CONTINUE
C
C-----PROCESS INTERVAL 1 = GREEN (START)
C
      IF ( NEXTTT(IRING) .EQ. -1 )               GO TO 7000
      NEXTPH=NEXTTT(IRING)
      IF ( NEXTPH .GT. 0)NEXT(NEXTPH) = .TRUE.
      NEXTPT(IRING)=NEXTPH
      IF ( ICPHAS .LE. 0 )                       GO TO 6020
      SEL(ICPHAS) = .FALSE.
C-----SYNC ENDING OF YELLOWS
      IF (TIMRCR(ICPHAS) .GT. DTD10)             GO TO 7000
      IF ((IOPHAS(IRING) .EQ. NEXTPT(IRING)) .AND.
     *    (IOPHAS(IRING) .GT. 0                   ))  THEN
C-----RETURNING TO IMMEDIATELY PREVIOUS PHASE
C-----RED REVERT MET FOR NEXT PHASE ?
        IF (TPT(IRING) .LT.
     *      TRR(IOPHAS(IRING))-TCI(ICPHAS)-TAR(ICPHAS))THEN
C-----KEEP THIS PHASE GREEN TO MEET RED REVERT FOR NEXT PHASE
          RRHOLD(IRING) = .TRUE.
                                                 GO TO 7000
        ELSE
          RRHOLD(IRING) = .FALSE.
        END IF
      END IF
C-----IF MEMORY CALL IS ENABLED
C-----AND THERE IS TIME LEFT ON THE GAP TIMER WHEN GREEN ENDS
C-----PUT A CALL ON THIS PHASE
      IF ((IMEM(ICPHAS) .EQ. IYES) .AND.
     *    (TRT(IRING) .GT. 0.0D0)       )        THEN
        CLPH(ICPHAS)   = .TRUE.
        CLPHMX(ICPHAS) = .TRUE.
      ELSE
        CLPHMX(ICPHAS) = .FALSE.
      END IF
C
C-----PROCESS START OF YELLOW CHANGE (START)
C
C rfi statistics for PREEMPT ?
       IF (TIME .GT. STRTIM)                     THEN
        IF ( GMT(ICPHAS) .EQ. 'G' )              THEN
C ------- GAP-OUT
          NGAPPH(ICPHAS) = NGAPPH(ICPHAS) + 1
          TGAPPH(ICPHAS) = TGAPPH(ICPHAS) + TPT(IRING)
          TRL = TRLAST(IRING)
          IF ( TRL .EQ. TVIMIN(ICPHAS) )         THEN
            NGRMIN(ICPHAS) = NGRMIN(ICPHAS) + 1
          ELSE IF ( TRL . EQ . TVI(ICPHAS) )     THEN
            NGRMAX(ICPHAS) = NGRMAX(ICPHAS) + 1
          ELSE
            NGRMID(ICPHAS) = NGRMID(ICPHAS) + 1
            TGRMID(ICPHAS) = TGRMID(ICPHAS) + TRL
          END IF
        END IF
        IF ( GMT(ICPHAS) .EQ. 'M' )              THEN
C ------- MAX-OUT
          NMAXPH(ICPHAS) = NMAXPH(ICPHAS) + 1
          TMAXPH(ICPHAS) = TMAXPH(ICPHAS) + TPT(IRING)
        END IF
        IF (PDEXCL(ICPHAS))                      THEN
C ------- EXCLUSIVE PEDESTRIAN TIMING
          NPDEXC(ICPHAS) = NPDEXC(ICPHAS) + 1
          TPDEXC(ICPHAS) = TPDEXC(ICPHAS) + TPT(IRING)
        END IF
      END IF
C-----PLACEMENT OF MINIMUM RECALL
      IF ( IMNR(ICPHAS) .EQ. IYES ) CLPH(ICPHAS) = .TRUE.
      GMT(ICPHAS) = ' '
      EOM(IRING) = TIMERR
      TVIBEG(ICPHAS) = TIMERR
      IF (PDEXCL(ICPHAS)) THEN
C----- DON'T TIME YELLOW
        TR = 0.0D0
      ELSE
        TR = TCI(ICPHAS)
      END IF
      TRT(IRING) = TR
      ICAMCT(IRING) = ICAMCT(IRING) + 1
      NEWCSP = .TRUE.
      INTER(IRING) = 2
C
C-----PROCESS START OF YELLOW CHANGE (END)
C
C
C-----PROCESS INTERVAL 1 = GREEN (END)
C
 5010 CONTINUE
C
C-----PROCESS INTERVAL 2 = YELLOW CHANGE (START)
C
                    IF ( TRT(IRING) .GT. 0.0D0 ) GO TO 7000
      IF (PDEXCL(ICPHAS)) THEN
C----- DON'T TIME RED CLEARANCE
        TR = 0.0D0
      ELSE
        TR = TAR(ICPHAS)
      END IF
C-----RED REVERT
      TRT(IRING) = TR
      ICAMCT(IRING) = 0
      NEWCSP = .TRUE.
      INTER(IRING) = 3
C
C-----PROCESS INTERVAL 2 = YELLOW CHANGE (END)
C
 6010 CONTINUE
C
C-----PROCESS INTERVAL 3 = RED CLEARANCE (START)
C
      IF ( TRT(IRING) .GT. 0.0D0 )               GO TO 7000
C-----LAST DT OF THIS PHASE
 6020 CONTINUE
      IF ( IOPHAS(IRING) .GT. 0) OPH(IOPHAS(IRING)) = .FALSE.
      IF ( ICPHAS .GT. 0 ) OPH(ICPHAS) = .TRUE.
      IOPHAS(IRING) = ICPHAS
      NEXTPH = NEXTPT(IRING)
      ICPHAT(IRING) = NEXTPH
      PEDCYC(IRING) = .FALSE.
      IF ( NEXTPH .GT. 0 )                       THEN
        ICAMCT(IRING) = ICAMPS(NEXTPH)
        CLPH(NEXTPH) = .FALSE.
        NEXT(NEXTPH) = .FALSE.
        IF (PEDS(NEXTPH) .AND. PDCALL(NEXTPH))   THEN
C-----PREPARE TO TIME PEDS AT START OF NEXT PHASE
          PEDCYC(IRING) = .TRUE.
          PDCALL(NEXTPH) = .FALSE.
          PEDINT(NEXTPH) = INTERG
          NEWPSI = .TRUE.
          PDHOLD(IRING) = .TRUE.
          PDSTAT(JP) = TDNONE
          PEDTEW(IRING) = TIME + TWK(NEXTPH)
          PEDTEC(IRING) = PEDTEW(IRING) + TPC(NEXTPH)
        END IF
      ELSE
        ICAMCT(IRING) = 0
      END IF
      NEWCSP = .TRUE.
      CALL MAXRCL(IGROUP,NEWPH)
      IF ( ICPHAS .GT. 0 )                       THEN
        IF ( .NOT. PDCALL(ICPHAS) )              THEN
          PDCALL(ICPHAS) = IPRCL(ICPHAS) .EQ. IYES
        END IF
      END IF
C-----PROCESS INTERVAL 3 = RED CLEARANCE (END)
 7000 CONTINUE
C-----PROCESS EACH RING BY INTERVAL TYPE (END)
 7005 CONTINUE
      IF ( NEWCSP )                              THEN
        CALL NEWCS
      END IF
 7010 CONTINUE
C-----PROCESS NEW PHASE (START)
      DO 7110 IRING = 1, NRING
      IF ( (.NOT. NEWPH(IRING)) )                          GO TO 7110
      IF ( CROSNG )                              THEN
        CROSED(IRING) = .TRUE.
      ELSE
        JP = NPHPS(IRING,IGROUP)
        IF ( JP .GT. 0)                          THEN
C-----LAST PHASE OF THE PREFERRED SEQ LIST ?
          IF(ICPHAT(IRING) .EQ. LPHPS(IRING,IGROUP,JP))THEN
            SERVED(IRING)=.TRUE.
          END IF
        END IF
      END IF
 7110 CONTINUE
 
C-----PROCESS NEW PHASE (END)
      IF ( CROSNG )                              THEN
        DO 7200 IR = 1, NRING
        IF ((ICPHAT(IR) .GT. 0) .AND. (.NOT. CROSED(IR)))  GO TO 7520
 7200   CONTINUE
C-----BARRIER HAS BEEN CROSSED BY ALL RINGS WITH ACTIVE PHASES
C-----CROSSING PROCESSING FOR RINGS WITHOUT AN ACTIVE PHASE (START)
        DO 7220 IRING = 1, NRING
        IF (NEXTTT(IRING) .EQ. -1)                         GO TO 7220
        NEXTPH = NEXTTT(IRING)
        ICPHAT(IRING) = NEXTPH
        IF ( NEXTPH .GT. 0 )                     THEN
          ICAMCT(IRING) = ICAMPS(NEXTPH)
          CLPH(NEXTPH) = .FALSE.
          NEXT(NEXTPH) = .FALSE.
        ELSE
          ICAMCT(IRING) = 0
        END IF
        NEWCSP = .TRUE.
        CALL MAXRCL(IGROUP,NEWPH)
        IF ( NEWCSP )                            THEN
          CALL NEWCS
        END IF
        IF ( (.NOT. NEWPH(IRING)) )                        GO TO 7210
        CROSED(IRING) = .TRUE.
 7210   CONTINUE
 7220   CONTINUE
C-----CROSSING PROCESSING FOR RINGS WITHOUT AN ACTIVE PHASE (END)
        CROSNG = .FALSE.
      IF (PREEMP)                                          GO TO 7380
C-----CHECK FOR NEW DEMAND ACROSS THE BARRIER IN RINGS WITHOUT AN ACTIVE
C-----PHASE; THIS IS DEMAND THAT OCCURRED WHEN CROSSING
        DO 7270 IR = 1, NRING
        IF ( ICPHAT(IR) .GT. 0 )                           GO TO 7270
C-----THIS RING DOESN'T HAVE PHASE SELECTED
        DO 7250 I = 1, NPHPS(IR,NXTGRP)
        JP = LPHPS(IR,NXTGRP,I)
        IF ( CLPH(JP) )                          THEN
C-----SELECT THIS PHASE TO BE THE ACTIVE PHASE
          ICPHAT(IR) = JP
          IPHPS(IR) = I
          TRT(IR) = TMI(JP)
          TPT(IR) = 0.0D0
          NEWCSP = .TRUE.
          ICAMCT(IR) = ICAMPS(JP)
          INTER(IR) = 1
          TVIBEG(JP) = TIMERR
          NEWPH(IR) = .TRUE.
          CLPH(JP) = .FALSE.
          IF (PEDS(JP) .AND. PDCALL(JP))   THEN
C-----PREPARE TO TIME PEDS AT START OF PHASE
            PEDCYC(IR) = .TRUE.
            PDCALL(JP) = .FALSE.
            PEDINT(JP) = INTERG
            NEWPSI     = .TRUE.
            PDHOLD(IR) = .TRUE.
            PDSTAT(JP) = TDNONE
            PEDTEW(IR) = TIME + TWK(JP)
            PEDTEC(IR) = PEDTEW(IR) + TPC(JP)
          END IF
                                                           GO TO 7255
        END IF
 7250   CONTINUE
 7255   CONTINUE
 7270   CONTINUE
C-----CHECK FOR THE DUAL/SINGLE ENTRY
C-----SHOULD BE DONE ONLY AFTER ALL RINGS HAVE BEEN PROCESSED
        DO 7370 IR = 1, NRING
        IF ( ICPHAT(IR) .GT. 0 )                           GO TO 7370
C-----THIS RING DOESN'T HAVE PHASE SELECTED
        DO 7360 IR1 = 1, NRING
C-----DOES THE ACTIVE PHASE IN ANY OTHER RING HAVE A DUAL ENTRY PHASE ?
        IF ( IR1 .EQ. IR )                                 GO TO 7360
        IF ( ICPHAT(IR1) .EQ. 0 )                          GO TO 7360
        IF ( IDEPH(ICPHAT(IR1)) .EQ. 0 )                   GO TO 7360
C-----PRELIMINARY DUAL ENTRY PHASE SELECTED
        JP = IDEPH(ICPHAT(IR1))
        DO 7350 I = 1, NPHPS(IR,IGROUT)
C----- IS THE PRELIMINARY PHASE IN THIS RING AND GROUP ?
        IF ( LPHPS(IR,IGROUT,I) .EQ. JP)         THEN
C-----DUAL ENTRY PHASE SELECTED
          ICPHAT(IR) = JP
          IPHPS(IR) = I
          TRT(IR) = TMI(JP)
          TPT(IR) = 0.0D0
          NEWCSP = .TRUE.
          ICAMCT(IR) = ICAMPS(JP)
          INTER(IR) = 1
          TVIBEG(JP) = TIMERR
          NEWPH(IR) = .TRUE.
        END IF
 7350   CONTINUE
 7360   CONTINUE
 7370   CONTINUE
 7380   CONTINUE
        IGROUP = NXTGRP
        DO 7510 IRING = 1 , NRING
        JP = ICPHAT(IRING)
        IF ( JP .GT. 0 ) TIMRCR(JP) = -9.99D0
        IF ( NPHPS(IRING,IGROUP) .EQ. 0 )        THEN
C----- NO PHASES TO SERVE
          SERVED(IRING) = .TRUE.
        ELSE
          IF ( NPHPS(IRING,IGROUP) .EQ. 1 )      THEN
            IF ( JP .GT. 0 )                     THEN
C-----THE ONLY PHASE IS BEING SERVED
              SERVED(IRING) = .TRUE.
            ELSE
              SERVED(IRING) = .FALSE.
            END IF
          ELSE
            SERVED(IRING) = .FALSE.
          END IF
        END IF
C=      SERVET(IRING) = (.NOT. SERVED(IRING))
C=      M = 7
C=      CALL DINCH ('     ',M,IRRING+IRING,51,IPGZ)
 7510   CONTINUE
C=      DABT=DAB
C=      IF(DAB)THEN
C=        M=15
C=      ELSE
C=        M=7
C=      END IF
C=      CALL DINCH('DAB',M,IRTIME,51,IPGZ)
        IF ( NEWCSP )                                      GO TO 7005
 7520   CONTINUE
      END IF
 8020 CONTINUE
C
C-----PROCESS MULTIPLE RING SIGNAL (END)
C
C-----SAVE TRAFFIC DETECTOR ACTUATIONS FOR ANIMATION
C-----SET ALL TRAFFIC DETECTORS TO FALSE
      DO 8030 I = 1, NLOOPS
      II = LLOOPS(I)
      CALL  PRE1LD  ( II )
      LDCROS(II) = .FALSE.
      LDTRIP(II) = .FALSE.
      LDCLER(II) = .FALSE.
      VDCNT (II) = .FALSE.
 8030 CONTINUE
      IF ( ANYPED )                              THEN
        DO  I = 1 , NPHASE
          JP = LPHASE(I)
C-----    PED DETECTORS ARE ALWAYS LOCKING EXCEPT DURING PED WALK
C-----    INTERVAL THE LOCK STATE IS STORED IN PDCALL
          PDTRIP(JP) = .FALSE.
        END DO
      END IF
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
c9320 CONTINUE
c     CALL  ABORTR  ( 'STOP 932 - ' //
c    *                'CURRENT PHASE COMBINATION NOT ON IPH - ' //
c    *                'NEMA'                                       )
c     STOP  932
      END                                                               NEMA
C
C
C
      SUBROUTINE HDWARE
C)    USE KERNEL32, ONLY: GetTickCount,Sleep,LoadLibrary,FreeLibrary,
C)   *                    GetProcAddress,CreateThread
C/    USE WINDOWS,  ONLY: GetTickCount,Sleep,LoadLibrary,FreeLibrary,
C/   *                    GetProcAddress,CreateThread
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CID'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C,    INTEGER           NPN2          , NOV2
C,    PARAMETER       ( NPN2 = NPN+NPN, NOV2 = NOV+NOV )
C,    CHARACTER*2       HASVEH(NPN,2),HASOVL(NOV,2),HASPED(NPN,2),
C,   *                  VEHMIS(NPN)  ,OVLMIS(NOV)  ,PEDMIS(NPN)
C,    CHARACTER*14      TXT1
C,    CHARACTER*20      DATTIM
C,    LOGICAL           MISMAT,LRET
C,    INTEGER           I,ILP,IRET,J,JP
C)    POINTER         ( GetPhasePfn,GetPhase )
C)    POINTER         ( GetOnlineCIDsPfn,GetOnlineCIDs )
C)    POINTER         ( ReadCIDPfn,ReadCID )
C)    POINTER         ( WriteCIDPfn,WriteCID )
C,    INTERFACE
C)      INTEGER FUNCTION GetPhase(A,B)
C)        !DEC$ ATTRIBUTES VALUE :: A,B
C)        INTEGER A,B
C/      STDCALL FUNCTION GetPhase(A,B)    RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A,B
C,      END FUNCTION
C)      INTEGER FUNCTION GetOnlineCIDs(X)
C/      STDCALL FUNCTION GetOnlineCIDs(X) RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C,        INTEGER X(10)
C,      END FUNCTION
C)      INTEGER FUNCTION ReadCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER A
C/      STDCALL FUNCTION ReadCID(A,X)     RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A
C,        BYTE    X(9)
C,      END FUNCTION
C)      INTEGER FUNCTION WriteCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER A
C/      STDCALL FUNCTION WriteCID(A,X)    RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A
C,        BYTE    X(9)
C,      END FUNCTION
C,    END INTERFACE
C,    DATA   HASOVL / NOV2 * "  " /
C,    DATA   HASPED / NPN2 * "  " /
C,    DATA   HASVEH / NPN2 * "  " /
C,    DATA   MISMAT / .FALSE. /
C,    DATA   OVLMIS / NOV  * "  " /
C,    DATA   PEDMIS / NPN  * "  " /
C,    DATA   VEHMIS / NPN  * "  " /
C,100 FORMAT(///," SETUP OF SIMPRO AND CID HARDWARE INTERFACE",//,
C,   *  "             PHASES        OVERLAPS    PEDESTRIANS",/,
C,   *  "         1 2 3 4 5 6 7 8   A B C D   1 2 3 4 5 6 7 8",/,
C,   *  " SIMPRO",2X,    8A2,2X,           4A2,2X,   8A2,/,
C,   *  "    CID",2X,    8A2,2X,           4A2,2X,   8A2)
C,958 FORMAT(39HSTOP 958 - NUMBER OF CONNECTED CID'S = ,I3,
C,   *       29H MUST BE EXACTLY 1 - HARDWARE )
C,961 FORMAT(9X,8A2,2X,4A2,2X,8A2,/,
C,   *       " SETUP OF SIMPRO AND HARDWARE DO NOT MATCH")
C,    IF(FIRSIG)                                 THEN
C-----START OF CODE FOR TESTING - FIRST TIME ONLY CODE
C,      TXT1 = "CIDAPI.DLL"//CHAR(0)
C,      I = LOC(TXT1)
C,      hDLL = LoadLibrary (%VAL(I))
C,      IF (hDLL .EQ. 0)                         GO TO 9540
C)      TXT1 = "GetOnlineCIDs"//CHAR(0)
C)      I = LOC(TXT1)
C)      GetOnlineCIDsPfn = GetProcAddress (hDLL,%VAL(I))
C)      IF (GetOnlineCIDsPfn .EQ. 0)             GO TO 9560
C)      TXT1 = "GetPhase"//CHAR(0)
C)      I = LOC(TXT1)
C)      GetPhasePfn = GetProcAddress (hDLL,%VAL(I))
C)      IF (GetPhasePfn .EQ. 0)                  GO TO 9560
C)      TXT1 = "ReadCID"//CHAR(0)
C)      I = LOC(TXT1)
C)      ReadCIDPfn = GetProcAddress (hDLL,%VAL(I))
C)      TXT1 = "WriteCID"//CHAR(0)
C)      I = LOC(TXT1)
C)      IF (ReadCIDPfn .EQ. 0)                   GO TO 9560
C)      WriteCIDPfn = GetProcAddress (hDLL,%VAL(I))
C)      IF (WriteCIDPfn .EQ. 0)                  GO TO 9560
C,      NCIDS = GetOnlineCIDs (CIDIDS)
C,      IF ( NCIDS .EQ. -1 )                     GO TO 9570
C,      IF ( NCIDS .NE.1 )                       GO TO 9580
C,      CIDID = CIDIDS(1)
C,      SIGVP = 0
C,      CIDIN = 0
C-----CLEAR ALL DETECTORS
C,      CIDOUT = 0
C-----PUT CIDID IN BUFFERS
C,      CIDOUT(1) = CIDID
C,      CIDIN(1)  = CIDID
C-----SEND AN EXTERNAL RESTART
C,      CIDOUT(9) = BIT(5)
C,      IRET = WriteCID(CIDID,CIDOUT)
C,      IF ( IRET .LT. 0 )                       GO TO 9600
C,      CALL Sleep (250)
C-----CLEAR EXT. RESTART BIT, SET CONTROLLER I/O TO MODE 2
C,      CIDOUT(9) = BIT(8)
C-----  I/O MODES FOR A, B AND C CONNECTORS MUST BE 0 FOR THIS TO WORK
C,      IRET = WriteCID(CIDID,CIDOUT)
C,      IF ( IRET .LT. 0 )                       GO TO 9600
C----- GET INITIAL SIGNAL SETTINGS
C,      CALL GETSIG
C-----LOOK AT DATA JUST COLLECTED BY GETSIG
C-----FIND CONTROLLER'S ACTIVE VEHICLE PHASES, OVERLAPS AND PED PHASES
C,      DO JP = 1,HPH
C,        CIDPH(JP)  = SIGV(JP) .GT. 0
C,        CIDPED(JP) = SIGP(JP) .GT. 0
C,        IF ( CIDPH (JP) ) HASVEH(JP,2) = "X"
C,        IF ( CIDPED(JP) ) HASPED(JP,2) = "X"
C,      END DO
C,      DO JP = 1,HOV
C,        CIDOVL(JP) = SIGO(JP) .GT. 0
C,        IF ( CIDOVL(JP) ) HASOVL(JP,2) = "X"
C,      END DO
C,      DO I = 1,NPHASE
C,        JP = LPHASE(I)
C,        HASVEH(JP,1) = "X"
C,        IF ( PEDS(JP) )HASPED(JP,1) = "X"
C,      END DO
C,      DO JP = 1,NOLP
C,        HASOVL(JP,1) = "X"
C,      END DO
C,      WRITE (6,100) (HASVEH(I,1),I=1,HPH),(HASOVL(I,1),I=1,HOV),
C,   *                (HASPED(I,1),I=1,HPH),
C,   *                (HASVEH(I,2),I=1,HPH),(HASOVL(I,2),I=1,HOV),
C,   *                (HASPED(I,2),I=1,HPH)
C,      WRITE (*,100) (HASVEH(I,1),I=1,HPH),(HASOVL(I,1),I=1,HOV),
C,   *                (HASPED(I,1),I=1,HPH),
C,   *                (HASVEH(I,2),I=1,HPH),(HASOVL(I,2),I=1,HOV),
C,   *                (HASPED(I,2),I=1,HPH)
C,      DO I = 1,HPH
C,        IF ( HASVEH(I,1) . NE. HASVEH(I,2) )   THEN
C,          VEHMIS(I) = "^"
C,          MISMAT = .TRUE.
C,        END IF
C,        IF ( HASPED(I,1) . NE. HASPED(I,2) )   THEN
C,          PEDMIS(I) = "^"
C,          MISMAT = .TRUE.
C,        END IF
C,      END DO
C,      DO I = 1,HOV
C,        IF ( HASOVL(I,1)  . NE. HASOVL(I,2) )  THEN
C,          OVLMIS(I) = "^"
C,          MISMAT = .TRUE.
C,        END IF
C,      END DO
C,      IF ( MISMAT )                            GO TO 9610
C-----TO WHICH OF HPH HARDWARE LOOPS IS EACH SIMPRO LOOP CONNECTED
C,      DO JP = 1,HPH
C,        DO I = 1,NLDF(JP)+NLDC(JP)+NLDE(JP)
C,          LDHDWR(LLD(I,JP)) = JP
C,        END DO
C,      END DO
C,      DO J = 1, NPHASE
C,        JP = LPHASE(J)
C,        IF ( PEDVOL(JP) . GT . 0 ) PDSTAT(JP) = -1
C,      END DO
C-----  CAUSE WRITE AT TIME 0.0
C,      NEWPSI = ANYPED
C,      CALL  GETCDT  ( DATTIM )
C,      WRITE (*,'(A,I4,2A)') 'Hardware-in-the-Loop Signal Sleep Time ='
C,   *                        ,HITLST,' seconds starting at   ',DATTIM
C,      CALL Sleep (HITLST*1000)
C,      CALL  GETCDT  ( DATTIM )
C,      WRITE (*,'(A,I4,2A)') 'Hardware-in-the-Loop Signal Sleep Time ='
C,   *                        ,HITLST,' seconds completed at  ',DATTIM
C,      TICKDT = DT / 1.0D-3
C,      TICKST = GetTickCount ()
C,      TICKNX = TICKST + TICKDT
C,      FIRSIG =.FALSE.
C,      CALL GETSIG
C
C-----  INITIALIZATION (END)
C
C,    END IF
C-----END OF CODE FOR TESTING - FIRST TIME ONLY CODE
C
C-----START OF CODE TO SEND VEHICLE AND PED DETECTOR STATES
C,    CALL  LDDLEX
C,    IF ( ANYPED )                              THEN
C,      CALL GETSIG
C,      CALL PREPPD
C,    END IF
C,    CALL  SNDDET
C-----END OF CODE TO SEND VEHICLE AND PED DETECTOR STATES
C
C,    IF ( TIME . GT . 0.0D0 )                   THEN
C-----START OF CODE TO PAUSE FOR REMAINDER OF THIS DT
C,    TICKDL = TICKNX - GetTickCount ()
C,    IF (TICKDL .LE. 0)                         THEN
C,      DTLAGS = DTLAGS + 1
C,      DTLAG = -TICKDL
C,    ELSE
C,      CALL Sleep (TICKDL)
C,      DTLAG = 0
C,    END IF
C,    TICKNX = MAX0(TICKNX + TICKDT,GetTickCount ())
C-----END OF CODE TO PAUSE FOR REMAINDER OF THIS DT
C
C-----START OF CODE TO GET SIGNAL INDICATIONS
C,    CALL GETSIG
C-----END OF CODE TO GET SIGNAL INDICATIONS
C,    END IF
C
C-----SET ALL TRAFFIC DETECTORS TO FALSE
C,    DO  I = 1, NLOOPS
C,      ILP = LLOOPS(I)
C,      CALL  PRE1LD  ( ILP )
C,      LDCROS(ILP) = .FALSE.
C,      LDTRIP(ILP) = .FALSE.
C,      LDCLER(ILP) = .FALSE.
C,      VDCNT (ILP) = .FALSE.
C,    END DO
C,    IF ( (TIME . GT . 0.0D0 ) . AND . ANYPED ) THEN
C,      DO  I = 1 , NPHASE
C,        JP = LPHASE(I)
C-----    PED CALLS ARE ALWAYS LOCKING EXCEPT DURING PED WALK
C-----    INTERVAL
C-----    THE LOCK STATE IS STORED IN PDCALL
C,        IF ( PDTRIP(JP) )                      THEN
C,          PDTRIP(JP) = .FALSE.
C,        END IF
C,      END DO
C,    END IF
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9540 CONTINUE
C,    CALL  ABORTR  ( 'STOP 954 - ' //
C,   *                'ERROR OPENING THE CID API FILE "CDIAPI.DLL"'
C,   *                // ' - ' //
C,   *                'HDWARE'                                         )
C,    STOP  954
 9550 CONTINUE
C,    CALL  ABORTR  ( 'STOP 955 - ' //
C,   *                'ERROR GETTING FUNCTION ADDRESS FROM CID API FILE'
C,   *                // ' - ' //
C,   *                'HDWARE'                                         )
C,    LRET = FreeLibrary ( hDLL )
C,    STOP  955
 9560 CONTINUE
C,    CALL  ABORTR  ( 'STOP 956 - ' //
C,   *                'ERROR GETTING FUNCTION ADDRESS FROM CID API FILE'
C,   *                // ' - ' //
C,   *                'HDWARE'                                         )
C,    CALL  ENDCID
C,    STOP  956
 9570 CONTINUE
C,    CALL  ABORTR  ( 'STOP 957 - ' //
C,   *                'ERROR GETTING NUMBER OF CONNECTED CIDS - ' //
C,   *                'HDWARE'                                       )
C,    CALL  ENDCID
C,    STOP  957
 9580 CONTINUE
C,    WRITE (ERRMSG,958) NCIDS
C,    CALL  ABORTR  ( ERRMSG )
C,    STOP  958
 9590 CONTINUE
C,    CALL  ABORTR  ( 'STOP 959 - ' //
C,   *                'ERROR SENDING CONTROLLER TYPE AND MODE TO CID'
C,   *                // ' - ' //
C,   *                'HDWARE'                                        )
C,    CALL  ENDCID
C,    STOP  959
 9600 CONTINUE
C,    CALL  ABORTR  ( 'STOP 960 - ' //
C,   *                'ERROR SENDING CONTROLLER MODE TO CID INPUTS ' //
C,   *                '63 & 64 - ' //
C,   *                'HDWARE'                                         )
C,    CALL  ENDCID
C,    STOP  960
 9610 CONTINUE
C,    WRITE (6,961) (VEHMIS(I),I=1,HPH),(OVLMIS(I),I=1,HOV),
C,   *              (PEDMIS(I),I=1,HPH)
C,    WRITE (*,961) (VEHMIS(I),I=1,HPH),(OVLMIS(I),I=1,HOV),
C,   *              (PEDMIS(I),I=1,HPH)
C,    CALL  ABORTR  ( 'STOP 961 - ' //
C,   *                'SETUP OF SIMPRO AND HARDWARE DO NOT MATCH - ' //
C,   *                'HDWARE'                                         )
C,    CALL  ENDCID
C,    STOP  961
      END                                                               HDWARE
C
C
C
      SUBROUTINE SNDCID
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C,    INTEGER           IRET
C)    POINTER         ( WriteCIDPfn,WriteCID )
C,    INTERFACE
C)      INTEGER FUNCTION WriteCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER A
C/      STDCALL FUNCTION WriteCID(A,X) RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A
C,        BYTE    X(9)
C,      END FUNCTION
C,    END INTERFACE
C-----WRITE 64 BITS TO CID
C,    CIDOUP = CIDOUT
C,    IRET = WriteCID(CIDID,CIDOUT)
C,    IF ( IRET < 0 )                            GO TO 9620
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9620 CONTINUE
C,    CALL  ABORTR  ( 'STOP 962 - ' //
C,   *                'ERROR SENDING 64 BITS TO CID - ' //
C,   *                'SNDCID'                             )
C,    CALL  ENDCID
C,    STOP  962
      END                                                               SNDCID
C
C
C
      SUBROUTINE GETCID
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C,    INTEGER           IRET
C)    POINTER         ( ReadCIDPfn,ReadCID )
C,    INTERFACE
C)      INTEGER FUNCTION ReadCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER A
C/      STDCALL FUNCTION ReadCID(A,X) RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A
C,        BYTE    X(9)
C,      END FUNCTION
C,    END INTERFACE
C-----READ 64 BITS FROM CID
C,    CIDINP = CIDIN
C,    IRET = ReadCID(CIDID,CIDIN)
C,    IF ( IRET .LT. 0 )                         GO TO 9630
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9630 CONTINUE
C,    CALL  ABORTR  ( 'STOP 963 - ' //
C,   *                'ERROR GETTING 64 BITS FROM CID - ' //
C,   *                'GETCID'                               )
C,    CALL  ENDCID
C,    STOP  963
      END                                                               GETCID
C
C
C
      SUBROUTINE ENDCID
C)    USE KERNEL32, ONLY: FreeLibrary
C/    USE WINDOWS , ONLY: FreeLibrary
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C,    CHARACTER*20      DATTIM
C,    LOGICAL           LRET
C,    INTEGER           IRET
C)    POINTER         ( CloseOnlineCIDsPfn,CloseOnlineCIDs )
C)    POINTER         ( WriteCIDPfn,WriteCID )
C,    INTERFACE
C)      SUBROUTINE CloseOnlineCIDs()
C/      STDCALL SUBROUTINE CloseOnlineCIDs()
C,      END SUBROUTINE
C)      INTEGER FUNCTION WriteCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER A
C/      STDCALL FUNCTION WriteCID(A,X) RESULT(FUNCTION_RESULT)
C/        INTEGER :: FUNCTION_RESULT
C/        INTEGER ,VALUE :: A
C,        BYTE    X(9)
C,      END FUNCTION
C,    END INTERFACE
C-----CLEAR ALL DETECTORS
C,    CIDOUT = 0
C-----PUT CIDID IN BUFFERS
C,    CIDOUT(1) = CIDID
C,    IRET = WriteCID(CIDID,CIDOUT)
C,    CALL  GETCDT  ( DATTIM )
C,    WRITE (*,'(2A)')
C,   *             'Hardware-in-the-Loop Signal closing connection to ',
C,   *             'CID at ',DATTIM
C     CALL  CloseOnlineCIDs
C,    LRET = FreeLibrary ( hDLL )
      RETURN
      END                                                               ENDCID
C
C
C
      SUBROUTINE SNDDET
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C,    BYTE              IBYTE
C,    INTEGER           I,ILD,J,JP
C)    POINTER         ( WriteCIDPfn,WriteCID )
C,    INTERFACE
C)      INTEGER FUNCTION WriteCID(A,X)
C)        !DEC$ ATTRIBUTES VALUE :: A
C)        INTEGER :: A
C)        BYTE    :: X(9)
C/      STDCALL FUNCTION WriteCID(A,X) RESULT(FUNCTION_RESULT)
C/        INTEGER ,VALUE :: A
C/        BYTE    X(9)
C/        INTEGER :: FUNCTION_RESULT
C,      END FUNCTION
C,    END INTERFACE
C-----SET LOOP DETECTOR STATE IN CID BUFFER
C-----IF ANY SOFTWARE DETECTOR CONNECTED TO A PHASE IS TRIPPED
C-----THEN THAT HARDWARE DETECTOR WILL BE SET TRIPPED
C-----SET PED DETECTOR STATE IN CID BUFFER
C-----WRITE BUFFER TO CID
C,    CIDOUP = CIDOUT
C,    CIDOUT(2) = 0
C-----DATA FOR THE 8 HARDWARE VEHICLE DETECTORS GOES IN CIDBUF(2)
C,    DO I = 1, NPHASE
C,      JP = LPHASE(I)
C,      DO J = 1, NLD(JP)
C,        ILD = LLD(J,JP)
C,        IF ( LDTRIP(ILD) )                      THEN
C,          CIDOUT(2) = IOR(CIDOUT(2), BIT(LDHDWR(ILD)))
C,          EXIT
C,        END IF
C,      END DO
C,    END DO
C,    IBYTE =Z'0F'
C,    CIDOUT(4) = IAND ( CIDOUT(4), IBYTE )
C-----DATA FOR 4 (2,4,6,8) PED DETECTORS GOES IN CIDBUF(4), 4 HIGH BITS
C,    ILD = 4
C,    DO JP = 2, NPHASE, 2
C,      ILD = ILD + 1
C,      IF ( PDTRIP(JP) )                        THEN
C,        CIDOUT(4) = IOR(CIDOUT(4), BIT(ILD))
C,      END IF
C,    END DO
C,    IF ( ( CIDOUT(2) .NE. CIDOUP(2) ).OR.
C,   *     ( CIDOUT(4) .NE. CIDOUP(4) ) )        THEN
C,      CALL SNDCID
C,    END IF
      RETURN
      END                                                               SNDDET
C
C
C
      SUBROUTINE GETSIG
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C,    INTEGER           CIDSIG(0:4),I,IRET
C)    POINTER         ( GetPhasePfn,GetPhase )
C-----CIDSIG IS TO CONVERT FROM CID INTERVALS TO SIMPRO INTERVALS
C,    INTERFACE
C)      INTEGER FUNCTION GetPhase(A,B)
C)        !DEC$ ATTRIBUTES VALUE :: A,B
C)        INTEGER A,B
C/      STDCALL FUNCTION GetPhase(A,B) RESULT(FUNCTION_RESULT)
C/        INTEGER ,VALUE :: A,B
C/        INTEGER :: FUNCTION_RESULT
C,      END FUNCTION
C,    END INTERFACE
C,    DATA     CIDSIG / 0,INTERR,INTERY,0,INTERG /
C,964 FORMAT(40HSTOP 964 - ERROR GETTING DATA FOR PHASE ,I1,
C,   *       18H FROM CID - GETSIG )
C,    SIGVP = SIGV
C-----GET VEHICLE, OVERLAP AND PEDESTRIAN SIGNAL STATE FROM CID
C-----READ CID DATA
C,    CALL GETCID
C-----VEHICLE PHASES 1 THRU 8
C,    DO I = 1,HPH
C,      IRET = GetPhase (CIDID,I)
C,      IF ( IRET < 0 )                          GO TO 9640
C,      SIGV(I) = CIDSIG(IRET)
C,    END DO
C-----OVERLAPS A B C D
C,    CALL GETOVL
C-----PEDESTRIANS FOR PHASES 2,4,6,8
C,    CALL GETPED
C,    CALL HDWRCS
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9640 CONTINUE
C,    WRITE (ERRMSG,964) I
C,    CALL  ABORTR  ( ERRMSG )
C,    CALL  ENDCID
C,    STOP  964
      END                                                               GETSIG
C
C
C
      SUBROUTINE GETOVL
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'TYPES'
      INCLUDE 'USER'
C,    TYPE (OVLBIT)     BITS(4)
C,    INTEGER           I
C,    INTEGER*4         OVLBUF
C,    EQUIVALENCE       (CIDIN(5),OVLBUF)
C-----GET STATE OF OVERLAP SIGNALS
C-----DATA FROM CID MUST BE IN CIDIN
C,    DATA     BITS   / OVLBIT ( Z'00000001',Z'00000002',Z'00000004' ),
C,   *                  OVLBIT ( Z'00000008',Z'00000010',Z'00000020' ),
C,   *                  OVLBIT ( Z'00000040',Z'00000080',Z'00000100' ),
C,   *                  OVLBIT ( Z'00000200',Z'00000400',Z'00000800' ) /
C,    SIGOP = SIGO
C,    DO I = 1,HOV
C-----CID HAS OVERLAPS A,B,C,D
C-----MUST CHECK YELLOW BEFORE RED, RED BLINKS WHEN YELLOW
C,      IF (AND( OVLBUF,BITS(I).R ) .NE. 0)      THEN
C,        SIGO(I) = INTERR
C,      ELSE IF (IAND(OVLBUF,BITS(I).Y) .NE. 0)  THEN
C,        SIGO(I) = INTERY
C,      ELSE IF (IAND(OVLBUF,BITS(I).G) .NE. 0)  THEN
C,        SIGO(I) = INTERG
C,      ELSE
C,        SIGO(I) = 0
C,      END IF
C,    END DO
      RETURN
      END                                                               GETOVL
C
C
C
      SUBROUTINE GETPED
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'TYPES'
      INCLUDE 'USER'
C,    TYPE (OVLBIT)     BITS(8)
C,    INTEGER           I
C,    INTEGER*1         BUF(4)
C,    INTEGER*4         PEDBUF
C,    EQUIVALENCE       (BUF,PEDBUF)
C-----GET STATE OF PEDESTRIAN SIGNALS
C-----DATA FROM CID MUST BE IN CIDIN
C,    DATA     BITS   / OVLBIT ( Z'00000000',Z'00000000',Z'00000000' ),
C,   *                  OVLBIT ( Z'00000010',Z'00000020',Z'00000040' ),
C,   *                  OVLBIT ( Z'00000000',Z'00000000',Z'00000000' ),
C,   *                  OVLBIT ( Z'00000080',Z'00000100',Z'00000200' ),
C,   *                  OVLBIT ( Z'00000000',Z'00000000',Z'00000000' ),
C,   *                  OVLBIT ( Z'00000400',Z'00000800',Z'00001000' ),
C,   *                  OVLBIT ( Z'00000000',Z'00000000',Z'00000000' ),
C,   *                  OVLBIT ( Z'00002000',Z'00004000',Z'00008000' ) /
C,    BUF(1) = CIDIN(6)
C,    BUF(2) = CIDIN(7)
C,    BUF(3) = CIDIN(8)
C,    BUF(4) = CIDIN(9)
C,    SIGPP = SIGP
C,    DO I = 2, HPH, 2
C-----CID HAS PEDESTRIANS FOR PHASES 2,4,6,8
C,      SIGP(I-1) = 0
C,      IF      ( IAND(PEDBUF,BITS(I).R) .NE. 0 )THEN
C,        SIGP(I) = INTERR
C,      ELSE IF ( IAND(PEDBUF,BITS(I).G) .NE. 0 )THEN
C,        SIGP(I) = INTERG
C,      ELSE IF ( IAND(PEDBUF,BITS(I).Y) .NE. 0 )THEN
C,        SIGP(I) = INTERY
C,      ELSE
C,        SIGP(I) = 0
C,      END IF
C,      IF ( PEDINT(I) .NE.  SIGP(I) )           THEN
C,        PEDINT(I) = SIGP(I)
C,        NEWPSI = .TRUE.
C,        IF ( SIGP(I) . EQ . INTERG )           THEN
C,          PDCALL(I) = .FALSE.
C,        END IF
C,      END IF
C,    END DO
      RETURN
      END                                                               GETPED
C
C
C
      SUBROUTINE PREPPD
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'INDEX'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
      INTEGER           J,JP
C-----PREPARE PEDESTRIAN DETECTOR DATA FOR WRITING TO POSDAT
      IF (TIME .GT. 0.0D0 )                      NEWPDA = .FALSE.
      DO  J = 1, NPHASE
        JP =  LPHASE(J)
        CALL PEDVAL ( JP )
        CALL PRE1PD ( JP )
      END DO
      RETURN
      END                                                               PREPPD
C
C
C
      SUBROUTINE PRE1PD (JP)
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
      INTEGER           II,JP
C-----PREPARE DATA FOR 1 PEDESTRIAN DETECTOR FOR WRITING TO POSDAT
      IF ( (PEDVOL(JP) . LE . 0   ) .AND.
     *     (IPRCL(JP)  . NE . IYES) )            RETURN
C-----PED DETECTORS ARE EITHER TRIPPED OR NOT TRIPPED
      II = TDNONE
      IF ( PDTRIP(JP) )                          THEN
        II = II + TDTRIP
      ELSE IF ( PDCALL(JP) )                     THEN
        II = II + TDLOCK
      END IF
      IF ( PDSTAT(JP) . NE . II )                THEN
          NEWPDA = .TRUE.
          PDSTAT(JP) = II
      END IF
      RETURN
      END                                                               PRE1PD
C
C
C
      SUBROUTINE PRE1LD ( ILD )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'USER'
      INTEGER           I,ILD
C-----PREPARE DATA FOR 1 LOOP DETECTOR FOR WRITING TO POSDAT
      I = TDNONE
C-----VEHICLE DETECTORS ARE (NOT TRIPPED), CROSSED, TRIPPED, CLEARED
      IF ( LDCROS(ILD) )                          I = I + TDCROS
      IF ( LDTRIP(ILD) )                          I = I + TDTRIP
      IF ( LDCLER(ILD) )                          I = I + TDCLER
      IF ( LDSTAT(ILD) . NE . I )                 THEN
        NEWTDA = .TRUE.
        LDSTAT(ILD) = I
      END IF
      RETURN
      END                                                               PRE1LD
C
C
C
      SUBROUTINE LDDLEX
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'ABIAS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LANE'
      INCLUDE 'LOOPS'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'USER'
      INCLUDE 'VEHF'
      INTEGER           MVLNLS
      PARAMETER       ( MVLNLS = MVL*NLS )
      LOGICAL           LDCL,LDCR,LDTR
      INTEGER           I,ILP
      DOUBLE PRECISION  TIMCLR(NLS),TIMTRP(MVL,NLS)
      SAVE              TIMCLR,TIMTRP
      DATA     TIMCLR / NLS   *-1.0D0 /
      DATA     TIMTRP / MVLNLS*-1.0D0 /
C
C-----PROCESS LOOP DETECTOR DELAY AND EXTEND
C-----ON ENTRY, LDCROS ,LDTRIP, LDCLER MUST ALREADY BE SET FOR THIS DT
C
C-----TIMTRP - TIME TO TRIP DETECTOR, CONSIDERING DELAY
C-----TIMCLR - TIME TO CLEAR DETECTOR, CONSIDERING EXTEND
C-----LDCROS - ON ENTRY, DETECTOR CROSSED THIS DT? W/O  DELAY, EXTEND
C-----         ON EXIT,  DETECTOR CROSSED THIS DT? WITH DELAY, EXTEND
C-----LDTRIP - ON ENTRY, DETECTOR TRIPPED? W/O  DELAY OR EXTEND
C-----         ON EXIT,  DETECTOR TRIPPED? WITH DELAY OR EXTEND
C-----LDCLER - ON ENTRY, DETECTOR CLEARED THIS DT? W/O  DELAY, EXTEND
C-----         ON EXIT,  FALSE, SET BUT NOT USED OUTSIDE LDDLEX
C-----LDTRCR - IS LOOP DETECTOR ALREADY TRIPPED(OCCUPIED) WHEN CROSSED
C-----LDTRPR - IS LOOP DETECTOR TRIPPED(OCCUPIED) THE DT BEFORE CROSSED
C-----LDCR - IS FRONT EDGE OF DETECTOR CROSSED THIS DT
C-----LDTR - IS DETECTOR TRIPPED THIS DT
C-----LDCL - IS BACK EDGE OF DETECTOR CLEARED THIS DT
C-----LDDELY - LOOP DETECTOR DELAY TIME ARRAY (0-15,1 THEN 16-30,2)
C-----LDEXTD - LOOP DETECTOR EXTEND TIMES (0.0-7.5 SEC, .5 SEC INCR)
C-----LDNV - NUMBER OF VEHICLES CURRENTLY OCCUPYING LOOP DETECTOR
C
C-----THESE ARE DEFINITIONS, NOT VARIABLES
C-----CROSS - FRONT BUMPER CROSSED INTO ZONE OF DETECTION
C-----        DETECTOR TURNED ON
C-----TRIP  - SOME PART OF VEHICLE IS IN ZONE OF DETECTION
C-----        DETECTOR IS ON (TRIPPED)
C-----CLEAR - REAR BUMPER CROSSED FROM ZONE OF DETECTION
C-----        DETECTOR TURNED OFF
      DO  I=1,NLOOPS
        ILP = LLOOPS(I)
        LDCR = LDCROS(ILP)
        LDTR = LDTRIP(ILP)
        LDCL = LDCLER(ILP)
        CALL LOOPDL (ILP,LDCROS(ILP),LDTRIP(ILP),LDCLER(ILP),
     *               TIMTRP(1,ILP),LDDELY(ILP))
        CALL LOOPEX (ILP,LDTRIP(ILP),LDCLER(ILP),TIMCLR(ILP),
     *               LDEXTD(ILP))
C-----FOR ANIMATION, CROSS AND CLEAR ARE ACTUAL, TRIP IS ADJUSTED FOR
C-----DELAY, EXTEND
      LDCROS(ILP) = LDCR
      LDCLER(ILP) = LDCL
      END DO
      RETURN
      END                                                               LDDLEX
C
C
C
      SUBROUTINE LOOPDL (ILP,LDCR,LDTR,LDCL,TTRIP,TDELAY)
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'USER'
      LOGICAL           LDCL,LDCR,LDTR,LDTRCR,LDTRPP(NLS),LDTRPR,TEMP
      INTEGER           ILP
      DOUBLE PRECISION  TTRIP,TDELAY
C----- ILP - LOOP NUMBER
C----- LDCR -  LOGICAL WAS DETECTOR CROSSED THIS DT
C----- LDTR -  LOGICAL IS DETECTOR TRIPPED THIS DT
C----- LDCL -  LOGICAL WAS DETECTOR CLEARED THIS DT
C----- TTRIP - TIME WHEN TO TRIP DELAYED DETECTOR
C----- TDELAY - TIME INTERVAL TO DELAY DETECTOR TRIP
      SAVE              LDTRPP,LDTRCR,LDTRPR
      DATA     LDTRCR /     .FALSE. /
      DATA     LDTRPP / NLS*.TRUE.  /
      DATA     LDTRPR /     .FALSE. /
C-----PROCESS LOOP DETECTOR DELAY
C-----ON ENTRY, LDCROS ,LDTRIP, LDCLER MUST ALREADY BE SET FOR THIS DT
C-----ASSUME NO MORE THAN 2 VEHICLES OCCUPY DETECTOR SIMULTANEOUSLY
      IF (TDELAY .EQ. 0.0D0)                RETURN
      IF (ITYPLD(ILP) .EQ. IPULS) THEN
        CALL PULSDL (ILP,LDCR,LDTR,LDCL,TTRIP,TDELAY)
        RETURN
      END IF
      TEMP = LDTR
      IF (LDCR)                                THEN
C-----INITIATE DELAY PERIOD
        LDCR = .FALSE.
        TTRIP = TIME + TDELAY
        IF (LDCL) THEN
          LDTR = .FALSE.
          RETURN
        ELSE
          LDTRPR = LDTRPP(ILP)
          LDTRCR = LDTR
        END IF
      END IF
      IF (TIME .LT. TTRIP)                   THEN
C-----STILL IN DELAY PERIOD
        LDTR = .FALSE.
        IF ((ITYPLD(ILP) .NE. IPULS) .AND. LDCL)  THEN
C-----NEVER TRIP FOR THIS VEHICLE
          TTRIP = -1.0D0
          LDCL = .FALSE.
C-----DON'T CHANGE DELAY PROCESSING
        ELSE
C-----ASSUME DETECTOR REMAINS AS IMMEDIATELY BEFORE BEING CROSSED
          LDTR = LDTRPR
        END IF
      END IF
      IF (TIME .EQ. TTRIP)                       THEN
C-----TRANSITION FROM DELAY TO TRIP
        TTRIP = -1.0D0
        IF ((.NOT.LDTR) .AND. LDCL)              THEN
          LDCR = .FALSE.
          LDTR = .FALSE.
          LDCL = .FALSE.
        ELSE
          LDCR = .TRUE.
          LDTR = .TRUE.
        END IF
      END IF
      LDTRPP(ILP) = TEMP
      RETURN
      END                                                               LOOPDL
C
C
      SUBROUTINE PULSDL ( ILP,LDCR,LDTR,LDCL,TTRIP,TDELAY )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
C*    INCLUDE 'RUTINE'
      INCLUDE 'USER'
      LOGICAL           LDCL,LDCLP(NLS),LDCR,LDTR
      INTEGER           I,ILP,J
      DOUBLE PRECISION  TDELAY,TTRIP(MVL)
      SAVE              I,LDCLP
      DATA     I      / 1          /
      DATA     LDCLP  / NLS*.TRUE. /
  951 FORMAT('STOP 951 - MORE THAN 4 VEHICLES OCCUPY DETECTOR ',
     *       I2,' SIMULTANEOUSLY - PULSDL' )
C
C-----ILP - LOOP NUMBER
C-----LDCR -  LOGICAL WAS DETECTOR CROSSED THIS DT
C-----LDTR -  LOGICAL IS DETECTOR TRIPPED THIS DT
C-----LDCL -  LOGICAL WAS DETECTOR CLEARED THIS DT
C-----TTRIP - TIME WHEN TO TRIP DELAYED DETECTOR
C-----TDELAY - TIME INTERVAL TO DELAY DETECTOR TRIP
C
C-----PROCESS PULSE LOOP DETECTOR DELAY
C-----ON ENTRY, LDCR ,LDTR, LDCL MUST BE SET FOR THIS DT
C-----ASSUME NO MORE THAN MVL VEHICLES OCCUPY DETECTOR SIMULTANEOUSLY
      IF (TIME .EQ. TTRIP(1))                    THEN
C-----  TRANSITION FROM DELAY TO TRIP
        IF (I .GT. 1)                          THEN
          DO J = 2, I
C-----      FIFO
            TTRIP(J-1) = TTRIP(J)
          END DO
          TTRIP(I) = -1.0D0
          I = I - 1
        ELSE
          TTRIP(I) = -1.0D0
        END IF
        IF (LDCR)                                THEN
C-----    ALSO INITIATE DELAY PERIOD FOR DIFFERENT VEHICLE
          IF (TTRIP(1).NE. -1.0D0)               THEN
            IF (I .EQ. MVL)                      GO TO 9510
            I = I + 1
          END IF
          TTRIP(I) = TIME + TDELAY
        END IF
        LDCR = .TRUE.
        LDTR = .TRUE.
        LDCLP(ILP) = .TRUE.
        RETURN
      END IF
      IF (LDCR) THEN
C-----  INITIATE DELAY PERIOD
        LDCR = .FALSE.
        LDTR = .FALSE.
        LDCL = LDCLP(ILP)
        LDCLP(ILP) = .FALSE.
        IF (TTRIP(1).NE. -1.0D0)                 THEN
          IF (I .EQ. MVL)        GO TO 9510
          I = I + 1
        ELSE
          IF (I .GT. 1)                          THEN
            DO J = 2, I
C-----        FIFO
              TTRIP(J-1) = TTRIP(J)
            END DO
            I = I - 1
          END IF
          TTRIP(I) = -1.0D0
        END IF
        TTRIP(I) = TIME + TDELAY
        RETURN
      END IF
      IF (TIME .LT. TTRIP(1))                    THEN
C-----  STILL IN DELAY PERIOD
        LDCR = .FALSE.
        LDTR = .FALSE.
      END IF
      LDCL = LDCLP(ILP)
      LDCLP(ILP) = .FALSE.
      RETURN
 9510 CONTINUE
      WRITE (ERRMSG,951) ILP
      CALL  ABORTR  ( ERRMSG )
      STOP  951
      END                                                               PULSDL
C
C
 
      SUBROUTINE LOOPEX ( ILP,LDTR,LDCL,TCLEAR,TEXTND )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'QUE'
      INCLUDE 'USER'
      LOGICAL           LDCL,LDTR
      INTEGER           ILP
      DOUBLE PRECISION  TCLEAR,TEXTND
C----- ILP - LOOP NUMBER
C----- LDTR -  LOGICAL IS DETECTOR TRIPPED THIS DT
C----- LDCL -  LOGICAL WAS DETECTOR CLEARED THIS DT
C----- TCLEAR - TIME WHEN TO CLEAR EXTENDED DETECTOR
C----- TEXTND - TIME INTERVAL TO EXTEND DETECTOR CLEAR
C
C-----EXTEND LOOP DETECTOR ACTUATION TIME PERIOD
C-----ON ENTRY, LDTR AND LDCL MUST BE SET FOR THIS DT
C
      IF (TEXTND .EQ. 0.0D0)                     RETURN
      IF (TIME .EQ. TCLEAR)                      THEN
C-----TRANSITION FROM EXTEND TO CLEAR
        TCLEAR = -1.0D0
        IF (LDCL)                                THEN
C-----ALSO INITIATE EXTEND PERIOD FOR DIFFERENT VEHICLE
          TCLEAR = TIME + TEXTND
          IF (LDTR) TCLEAR = TCLEAR + DT
          IF (ITYPLD(ILP) .EQ. IPULS) TCLEAR = TCLEAR - DT
          LDTR = .TRUE.
          LDCL = .FALSE.
        ELSE
          LDTR = .FALSE.
          LDCL = .TRUE.
        END IF
        RETURN
      END IF
      IF (LDCL)                                  THEN
C-----INITIATE EXTEND PERIOD
        TCLEAR = TIME + TEXTND
        IF (LDTR) TCLEAR = TCLEAR + DT
        IF (ITYPLD(ILP) .EQ. IPULS) TCLEAR = TCLEAR - DT
        LDCL = .FALSE.
      END IF
      IF (TIME .LT. TCLEAR)                      THEN
C----- IN EXTEND PERIOD
        LDTR = .TRUE.
      END  IF
      RETURN
      END                                                               LOOPEX
C
C
      SUBROUTINE PREMPT
C                       ( IPREEM,TIME )                                 RFI
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'INDEX'
      INCLUDE 'QUE'
      INCLUDE 'USER'
C     INTEGER           IPREEM(0:NRG)                                   RFI
C     DOUBLE PRECISION  TIME                                            RFI
C-----IPREEM(0) = 0 END AN EXISTING PREEMPTION
C-----          > 0 GROUP TO PREEMPT TO
C-----IPREEM(1 TO 4)  A PHASE IN THE GROUP TO PREEMPT TO
C
C-----PREPARE DATA TO INITIATE START OR END OF PREMPTION
C
C     IF ( DABS(TIME - 110.0D0) .LT. 0.01D0 )     THEN                   RFI
C-----ASSIGN GROUP AND PHASE(S) TO PREEMPT TO                            RFI
C       IPREEM=0                                                         RFI
C       IPREEM(0)=1                                                      RFI
C       IPREEM(1)=2                                                      RFI
C     END IF                                                             RFI
C     IF ( DABS(TIME - 110.5D0) .LT. 0.01D0 )     THEN                   RFI
C-----TERMINATE PREEMPTION
C       IPREEM=0                                                         RFI
C     END IF                                                             RFI
      RETURN
      END                                                                PREMPT
C
C
C
 
      SUBROUTINE TIMRS1
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      INTEGER           IR,JP
      DOUBLE PRECISION  TIMRMX
C
C-----PREPARE TIMERS TO MAKE SURE THAT ALL PHASES END AT THE SAME TIME
C
      TIMRMX=0.0D0
      DO 100 IR = 1, NRING
      JP = ICPHAT(IR)
      IF (JP.GT.0)THEN
        TIMRMX=DMAX1(TIMRMX,DMAX1(0.0D0,TII(JP)+TVI(JP)-TPT(IR))+
     *               TCI(JP)+TAR(JP))
      END IF
  100 CONTINUE
      DO 200 IR = 1, NRING
      JP = ICPHAT(IR)
      IF ( JP .EQ. 0 )                                     GO TO  200
      TIMRCR(JP) = TIMRMX - (TCI(JP) + TAR(JP))
      IF ( TIMRCR(JP) .GT. (DT / 1.0D1) )        THEN
        TIMRCR(JP) = INT(TIMRCR(JP) / DT) * DT
        HOLD(JP) = .TRUE.
      END IF
  200 CONTINUE
      RETURN
      END                                                               TIMRS1
C
C
C
      SUBROUTINE MAXRCL ( IGROUP,NEWPH )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'INDEX'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      LOGICAL           NEWPH(NRG)
      INTEGER           IGROUP
C
C-----PLACEMENT OF MAXIMUM RECALL
C
      IF ( NEXTPH .GT. 0 )                       THEN
        IF ( IMXR(NEXTPH) . EQ . IYES )          THEN
          EOM(IRING) = DMAX1( TMX(NEXTPH),TMI(NEXTPH) )
          CLPH(NEXTPH) = .TRUE.
          TVIBEG(NEXTPH) = TVITBR(NEXTPH)
        ELSE
          TVIBEG(NEXTPH) = TIMERR
        END IF
      END IF
      INTER(IRING) = 1
      IDOR(IRING,IGROUP) = .FALSE.
      NEXTTT(IRING) = -1
      TP = 0.0D0
      TPT(IRING) = TP
      IF ( NEXTPH .GT. 0 )                       THEN
        IF ( VOLDEN(NEXTPH) )                    THEN
          TR = TIIADD(NEXTPH)*TIIVEH(NEXTPH)
          TR = DMAX1( DMIN1( TR,TIIMAX(NEXTPH) ),TMI(NEXTPH) )
          IF ( TIME . GT . STRTIM )              THEN
            IF ( TR . EQ . TMI(NEXTPH) )         THEN
              NAIMIN(NEXTPH) = NAIMIN(NEXTPH) + 1
            ELSE IF ( TR . EQ . TIIMAX(NEXTPH) ) THEN
              NAIMAX(NEXTPH) = NAIMAX(NEXTPH) + 1
            ELSE
              NAIMID(NEXTPH) = NAIMID(NEXTPH) + 1
              TAIMID(NEXTPH) = TAIMID(NEXTPH) + TR
            END IF
          END IF
          TIIVEH(NEXTPH) = 0.0D0
        ELSE
          TR = TMI(NEXTPH)
        END IF
      END IF
      TRT(IRING) = TR
      NEWPH(IRING) = .TRUE.
      RETURN
      END                                                               MAXRCL
C
C
C
      SUBROUTINE NEMDS1
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C=    INTEGER           I,M
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'NEMDS1'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    IPGZ=1
C=    IRMAX=23
C=    CALL INITRM
C=    CALL ACTPG (IPGZ)
C=    CALL CLRSCR(IRMAX)
C=    IRADD=IRMAX+1-((NLOOPS+5)/6)
C=   *             -(1+NPHASE)
C=   *             -1
C=   *             -((NIBL+17)/18)
C=   *             -1
C=   *             -3
C=   *             -2
C=   *             -(1+NRING)
C=    IRDTCT=0
C=    IRPHAS=IRDTCT+((NLOOPS+5)/6)+1
C=    IF(IRADD .GE. 01)IRPHAS=IRPHAS+1
C=    IF(IRADD .GE. 07)IRPHAS=IRPHAS+1
C=    IRSTAT=IRPHAS+NPHASE
C=    IF(IRADD .GE. 02)IRSTAT=IRSTAT+1
C=    IF(IRADD .GE. 08)IRSTAT=IRSTAT+1
C=    IRSIGS=IRSTAT+1
C=    IF(IRADD .GE. 06)IRSIGS=IRSIGS+1
C=    IF(IRADD .GE. 12)IRSIGS=IRSIGS+1
C=    IROVLP=IRSIGS+((NIBL+17)/18)
C=    IRTMRS=IROVLP+1
C=    IF(IRADD .GE. 04)IRTMRS=IRTMRS+1
C=    IF(IRADD .GE. 10)IRTMRS=IRTMRS+1
C=    IROPTS=IRTMRS+2
C=    IF(IRADD .GE. 05)IROPTS=IROPTS+1
C=    IF(IRADD .GE. 11)IROPTS=IROPTS+1
C=    IRRING=IRMAX-NRING
C=    IRTIME=IRMAX
C=    ICRN=0
C=    ICGR=ICRN+2
C=    ICPH=ICGR+2
C=    ICCA=ICPH+2
C=    ICNX=ICCA+5
C=    ICHO=ICNX+5
C=    ICSE=ICHO+5
C=    ICDE=ICSE+4
C=    ICII=ICDE+4
C=    ICVI=ICII+5
C=    ICMX=ICVI+5
C=    ICCI=ICMX+6
C=    ICAR=ICCI+5
C=    ICLD=ICAR+5
C=    DO 40 I = 1, NOLP
C=    IOVRLT(I) = -1
C= 40 CONTINUE
C=    M = 15
C=    CALL DINCH('NEMA',M,IRRING,67,IPGZ)
      RETURN
      END                                                               NEMDS1
C
C
C
      SUBROUTINE NEMDS2
C=   *                  ( CROSNG,SERVED )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C=    LOGICAL           CROSNG,SERVED(NRG)
C=    INTEGER           I,IC,IG,IGT,II,IRING,IRT,J,JP,M
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'NEMDS2'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    M=7
C=    CALL DINCH('STATES:',M,IRSTAT,0,IPGZ)
C=    CALL DINCH('SIGNAL:',M,IRSIGS,0,IPGZ)
C=    CALL DINCH('OVRLPS:',M,IROVLP,0,IPGZ)
C=    IRADD=0
C=    IC=9
C
C-----SPACE FOR OPTIONS AND TIMERS
C
C=    DO 60 I=1,NOP
C=    IF(I.EQ.7)THEN
C=      IRADD=IRADD+1
C=      IC=9
C=    END IF
C=    IF(OPTN(I))THEN
C=      M=15
C=    ELSE
C=      M=7
C=    END IF
C=    IC=IC+7
C= 60 CONTINUE
C=    M=7
C=    NLINE( 1:40)='R G P CALL NEXT HOLD SEL DE   TII  TVI  '
C=    NLINE(41:80)=' TMX  TCI  TAR  L1 L2 L3 L4 L5 L6 L7 L8 '
C=    CALL DINCH(NLINE(1:80),M,IRPHAS-1,0,IPGZ)
C=    IRT=-1
C=    IGT=-1
C=    DO 100 I=1,NPHASE
C=    JP=LPHASE(I)
C=    DO 90 IG=1,NGROUP
C=    DO 80 IRING=1,NRING
C=    DO 70 II=1,NPHPS(IRING,IG)
C=    IF(LPHPS(IRING,IG,II).EQ.JP)THEN
C=      IF(IRT.NE.IRING)THEN
C=        IRT=IRING
C=        IGT=-1
C=        WRITE (NLINE(1:1),'(I1)') IRING
C=        CALL DINCH(NLINE(1:1),M,IRPHAS+I-1,ICRN,IPGZ)
C=      END IF
C=      IF(IGT.NE.IG)THEN
C=        IGT=IG
C=        WRITE (NLINE(1:1),'(I1)') IG
C=        CALL DINCH(NLINE(1:1),M,IRPHAS+I-1,ICGR,IPGZ)
C=      END IF
C=                                                          GO TO     95
C=    END IF
C= 70 CONTINUE
C= 80 CONTINUE
C= 90 CONTINUE
C=    CALL DINCH('X',M,IRPHAS+I-1,ICRN,IPGZ)
C=    CALL DINCH('X',M,IRPHAS+I-1,ICGR,IPGZ)
C= 95 CONTINUE
C=    WRITE (NLINE(1:1),'(I1)') JP
C=    CALL DINCH(NLINE(1:1),M,IRPHAS+I-1,ICPH,IPGZ)
C=    IF(IDEPH(JP) .GT. 0)THEN
C=      WRITE (NLINE(1:3),'(I3)') IDEPH(JP)
C=      CALL DINCH(NLINE(1:3),M,IRPHAS+I-1,ICDE,IPGZ)
C=    END IF
C=    WRITE (NLINE(1:4),'(F4.1)') TII(JP)
C=    CALL DINCH(NLINE(1:4),M,IRPHAS+I-1,ICII,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TVI(JP)
C=    CALL DINCH(NLINE(1:4),M,IRPHAS+I-1,ICVI,IPGZ)
C=    WRITE (NLINE(1:5),'(F5.1)') TMX(JP)
C=    CALL DINCH(NLINE(1:5),M,IRPHAS+I-1,ICMX,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TCI(JP)
C=    CALL DINCH(NLINE(1:4),M,IRPHAS+I-1,ICCI,IPGZ)
C=    WRITE (NLINE(1:4),'(F4.1)') TAR(JP)
C=    CALL DINCH(NLINE(1:4),M,IRPHAS+I-1,ICAR,IPGZ)
C=100 CONTINUE
C=    CALL DINCH('RING  EOM PH IN   TP     TR    NX',M,IRRING,0,IPGZ)
C=    CALL DINCH('TIME: ',M,IRTIME,67,IPGZ)
C=    DO 110 J=1,NPHASE
C=    CALL LDCSH(LPHASE(J),IRPHAS,ICLD)
C=110 CONTINUE
C=    DO 117 IG=1,NGROUP
C=    DO 113 IRING=1,NRING
C=    IDORT(IRING,IG)=.NOT. IDOR(IRING,IG)
C=    SERVET(IRING)=.NOT. SERVED(IRING)
C=113 CONTINUE
C=117 CONTINUE
C=    CROSST=.NOT. CROSNG
C=    DABT=DAB
C=    IF(DAB)THEN
C=      M=15
C=    ELSE
C=      M=7
C=    END IF
C=    CALL DINCH('DAB',M,IRTIME,51,IPGZ)
      RETURN
      END                                                               NEMDS2
C
C
C
      SUBROUTINE NEMDS3
C=   *                  ( CROSNG,SERVED,IGROUP )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CHARAC'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LOOPS'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
C=    INCLUDE 'TESTER'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C=    LOGICAL           CROSNG,SERVED(NRG)
C=    INTEGER           I,IC,IGROUP,IGT,II,IR,IRING,J,JP,M
C
C*    NRNAME = 1
C*    IRNAME(NRNAME) = 'NEMDS3'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C=    DO 130 J=1,NLOOPS
C=    CALL LDSH(J)
C=130 CONTINUE
C=    DO 140 J=1,NPHASE
C=    JP=LPHASE(J)
C=    CALL CASH(CLPH,JP,IRPHAS,ICCA)
C=    CALL NXSH(NEXT,JP,IRPHAS,ICNX)
C=    CALL HOSH(HOLD,JP,IRPHAS,ICHO)
C=    CALL SESH(SEL ,JP,IRPHAS,ICSE)
C=140 CONTINUE
C=    IF(CROSST.NEQV.CROSNG)THEN
C=      CROSST=CROSNG
C=      IF(CROSNG)THEN
C=        M=15
C=      ELSE
C=        M=7
C=      END IF
C=      CALL DINCH('CROSSING',M,IRSTAT,8,IPGZ)
C=    END IF
C=    DO 160 IRING=1,NRING
C=    IF(ICPHAT(IRING).GT.0)THEN
C=      M=10
C=      IF(INTER(IRING).EQ.2)M=14
C=      IF(INTER(IRING).EQ.3)M=12
C=      WRITE (NLINE(1:33),'(I3,1X,F5.2,2I3,2F7.2,I4)',ERR=150)
C=   *    IRING,EOM(IRING),ICPHAT(IRING),INTER(IRING),TPT(IRING),
C=   *    TRT(IRING),NEXTTT(IRING)
C=    ELSE
C=      M=7
C=      WRITE (NLINE(1:33),'(I3,6X,I3,17X,I4)',ERR=150) IRING,
C=   *    ICPHAT(IRING),NEXTTT(IRING)
C=    END IF
C=150 CONTINUE
C=    I=IRRING+IRING
C=    CALL DINCH(NLINE(1:33),M,I,0,IPGZ)
C=    LTEMP=IDOR(IRING,IGROUP)
C=    IF(IDORT(IRING,IGROUP).NEQV.LTEMP)THEN
C=      IDORT(IRING,IGROUP)=LTEMP
C=      IF(LTEMP)THEN
C=        M=15
C=      ELSE
C=        M=7
C=      END IF
C=      CALL DINCH('DOR',M,I,38,IPGZ)
C=    END IF
C=    IF(CROSNG)THEN
C=      M=7
C=      IF(ICPHAT(IRING).GT.0) THEN
C=        WRITE (NLINE,'(F5.2)') TIMRCR(ICPHAT(IRING))
C=      END IF
C=      CALL DINCH(NLINE(1:5),M,I,51,IPGZ)
C=    ELSE
C=      LTEMP=SERVED(IRING)
C=      IF(SERVET(IRING).NEQV.LTEMP)THEN
C=        SERVET(IRING)=LTEMP
C=        IF(LTEMP)THEN
C=          M=15
C=        ELSE
C=          M=7
C=        END IF
C=        CALL DINCH('SERVED ',M,I,43,IPGZ)
C=      END IF
C=    END IF
C=160 CONTINUE
C=    DO 180 I=1,NOLP
C=    IC=8+(I-1)*4
C=    M=7
C=    IF(IOVRLP(I).EQ.1)M=10
C=    IF(IOVRLP(I).EQ.2)M=14
C=    IF(IOVRLT(I).EQ.M)                                      GO TO  180
C=    IOVRLT(I)=M
C=    II=ICAMPH(LOLP(I))
C=    CALL DINCH('OL'//CHAR( ICHAR( 'A' )-1+II ),M,IROVLP,IC,IPGZ)
C=180 CONTINUE
C=    WRITE (NLINE(1:7),'(F7.2)') TIME
C=    M=7
C=    CALL DINCH(NLINE(1:7),M,IRTIME,73,IPGZ)
      RETURN
      END                                                               NEMDS3
C
C
      SUBROUTINE NEWCS
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'INDEX'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      INTEGER           I
C
C----- NEW CAMSTACK POSITION
C
      CALL TOGCS
      CALL MAKECS (ICAMCT(1),ICAMCT(2),ICAMPC)
      DO 100 I = 3, NRING
      CALL MAKECS (ICAMPC,ICAMCT(I),ICAMPC)
  100 CONTINUE
      CALL OVLP
      RETURN
      END                                                               NEWCS
C
C
C
      SUBROUTINE MAKECS ( II,JJ,KK )
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'ANIMAT'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'LANE'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'USER'
      CHARACTER*1       FSET(25)
      INTEGER           I,II,J,JJ,JSISET,K,KK,KSISET(4,4,4),LSET(25),
     *                  MRGL,MRGR,MRGS,MTURN,PSET(25),RSET(25),SSET(25)
C-----KSISET(4,4,4) INDEXED BY (MRGL,MRGS,MRGR) WHERE MRGL/MRGS/MRGR IS
C-----SIGNAL INDICATION WHERE 1=R 2=A 3=G 4=P
      DATA     KSISET / 03,08,06,25,14,22,-1,-1,12,-1,21,-1,-1,-1,-1,-1,
     *                  20,16,-1,-1,10,02,05,24,-1,11,19,-1,-1,-1,-1,-1,
     *                  18,-1,15,-1,-1,17,13,-1,09,07,01,23,-1,-1,-1,-1,
     *                  -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,04/
C-----FSET IS FIRST CHARACTER OF SIGNAL SETTING (SUCH AS "AG" OR "LPR")
C-----LSET IS SIGNAL INDICATION FOR LEFT     WHERE 1=R 2=A 3=G 4=P
C-----SSET IS SIGNAL INDICATION FOR STRAIGHT WHERE 1=R 2=A 3=G 4=P
C-----RSET IS SIGNAL INDICATION FOR RIGHT    WHERE 1=R 2=A 3=G 4=P
C-----PSET IS SECOND CHARACTER OF SIGNAL SETTING CONVERTED TO SIGNAL
C-----INDICATION WHERE 1=R 2=A 3=G 4=P
      DATA FSET( 1),LSET( 1),SSET( 1),RSET( 1),PSET( 1) / 'A',3,3,3,0 / AG
      DATA FSET( 2),LSET( 2),SSET( 2),RSET( 2),PSET( 2) / 'A',2,2,2,0 / AA
      DATA FSET( 3),LSET( 3),SSET( 3),RSET( 3),PSET( 3) / 'A',1,1,1,0 / AR
      DATA FSET( 4),LSET( 4),SSET( 4),RSET( 4),PSET( 4) / 'A',4,4,4,0 / AP
      DATA FSET( 5),LSET( 5),SSET( 5),RSET( 5),PSET( 5) / 'L',3,2,2,3 / LGA
      DATA FSET( 6),LSET( 6),SSET( 6),RSET( 6),PSET( 6) / 'L',3,1,1,3 / LGR
      DATA FSET( 7),LSET( 7),SSET( 7),RSET( 7),PSET( 7) / 'L',2,3,3,2 / LAG
      DATA FSET( 8),LSET( 8),SSET( 8),RSET( 8),PSET( 8) / 'L',2,1,1,2 / LAR
      DATA FSET( 9),LSET( 9),SSET( 9),RSET( 9),PSET( 9) / 'L',1,3,3,1 / LRG
      DATA FSET(10),LSET(10),SSET(10),RSET(10),PSET(10) / 'L',1,2,2,1 / LRA
      DATA FSET(11),LSET(11),SSET(11),RSET(11),PSET(11) / 'S',2,3,2,3 / SGA
      DATA FSET(12),LSET(12),SSET(12),RSET(12),PSET(12) / 'S',1,3,1,3 / SGR
      DATA FSET(13),LSET(13),SSET(13),RSET(13),PSET(13) / 'S',3,2,3,2 / SAG
      DATA FSET(14),LSET(14),SSET(14),RSET(14),PSET(14) / 'S',1,2,1,2 / SAR
      DATA FSET(15),LSET(15),SSET(15),RSET(15),PSET(15) / 'S',3,1,3,1 / SRG
      DATA FSET(16),LSET(16),SSET(16),RSET(16),PSET(16) / 'S',2,1,2,1 / SRA
      DATA FSET(17),LSET(17),SSET(17),RSET(17),PSET(17) / 'R',2,2,3,3 / RGA
      DATA FSET(18),LSET(18),SSET(18),RSET(18),PSET(18) / 'R',1,1,3,3 / RGR
      DATA FSET(19),LSET(19),SSET(19),RSET(19),PSET(19) / 'R',3,3,2,2 / RAG
      DATA FSET(20),LSET(20),SSET(20),RSET(20),PSET(20) / 'R',1,1,2,2 / RAR
      DATA FSET(21),LSET(21),SSET(21),RSET(21),PSET(21) / 'R',3,3,1,1 / RRG
      DATA FSET(22),LSET(22),SSET(22),RSET(22),PSET(22) / 'R',2,2,1,1 / RRA
      DATA FSET(23),LSET(23),SSET(23),RSET(23),PSET(23) / 'L',4,3,3,4 / LPG
      DATA FSET(24),LSET(24),SSET(24),RSET(24),PSET(24) / 'L',4,2,2,4 / LPA
      DATA FSET(25),LSET(25),SSET(25),RSET(25),PSET(25) / 'L',4,1,1,4 / LPR
  929 FORMAT('STOP 929 - ISISET LT 0 FOR MERGING ISISET(',I2,',',I2,
     *       ') AND ISISET(',I2,',',I2,') - MAKECS')
C
C-----SUBROUTINE MAKECS DYNAMICALLY BUILDS A CAMSTACK POSITION BY
C-----MERGING CAMSTACK POSITION II AND CAMSTACK POSITION JJ, THEN
C-----STORING THE RESULT IN CAMSTACK POSITION KK.
C
C[    I          = -2147483647
C[    J          = -2147483647
C[    JSISET     = -2147483647
C[    K          = -2147483647
C[    MRGL       = -2147483647
C[    MRGR       = -2147483647
C[    MRGS       = -2147483647
C[    MTURN      = -2147483647
C*    NRNAME = NRNAME + 1
C*    IRNAME(NRNAME) = 'MAKECS'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
C----- USE ALL RED IN EACH LANE FOR CAMSTACK POSITION 0
      I = 3
      J = 3
      DO 2030  K = 1 , NIBL
      IF ( II . GT . 0 ) I = ISISET(II,K)
      IF ( JJ . GT . 0 ) J = ISISET(JJ,K)
      JSISET = 0
      IF ( (I.EQ.0) . OR . (J.EQ.0) )            GO TO 2020
      MRGL = MAX0( LSET(I),LSET(J) )
      IF ((FSET(I).EQ.'L').AND.(FSET(J).NE.'L')) MRGL = PSET(I)
      IF ((FSET(I).NE.'L').AND.(FSET(J).EQ.'L')) MRGL = PSET(J)
      MRGS = MAX0( SSET(I),SSET(J) )
      IF ((FSET(I).EQ.'S').AND.(FSET(J).NE.'S')) MRGS = PSET(I)
      IF ((FSET(I).NE.'S').AND.(FSET(J).EQ.'S')) MRGS = PSET(J)
      MRGR = MAX0( RSET(I),RSET(J) )
      IF ((FSET(I).EQ.'R').AND.(FSET(J).NE.'R')) MRGR = PSET(I)
      IF ((FSET(I).NE.'R').AND.(FSET(J).EQ.'R')) MRGR = PSET(J)
      JSISET = KSISET(MRGL,MRGS,MRGR)
      IF ( JSISET . GT . 0 )                     GO TO 2020
      MTURN = LTURN(LLANER(K))
                    IF ( MTURN . GE . LTURNU )   MTURN = MTURN - LTURNU
      GO TO ( 1010,1020,1030,1040,1050,1060,1070 ) MTURN
 1010 CONTINUE
C-----MTURN=1 THUS LEFT=N STRAIGHT=N RIGHT=Y
C[    IF ( MRGR               .EQ.-2147483647   )STOP 'MAKECS MRGR   01'
      MRGL = MRGR
      MRGS = MRGR
      GO TO 2010
 1020 CONTINUE
C-----MTURN=2 THUS LEFT=N STRAIGHT=Y RIGHT=N
C[    IF ( MRGS               .EQ.-2147483647   )STOP 'MAKECS MRGS   01'
      MRGL = MRGS
      MRGR = MRGS
      GO TO 2010
 1030 CONTINUE
C-----MTURN=3 THUS LEFT=N STRAIGHT=Y RIGHT=Y
C[    IF ( MRGS               .EQ.-2147483647   )STOP 'MAKECS MRGS   02'
      MRGL = MRGS
      GO TO 2010
 1040 CONTINUE
C-----MTURN=4 THUS LEFT=Y STRAIGHT=N RIGHT=N
C[    IF ( MRGL               .EQ.-2147483647   )STOP 'MAKECS MRGL   01'
      MRGS = MRGL
      MRGR = MRGL
      GO TO 2010
 1050 CONTINUE
C-----MTURN=5 THUS LEFT=Y STRAIGHT=N RIGHT=Y
C[    IF ( MRGR               .EQ.-2147483647   )STOP 'MAKECS MRGR   02'
      MRGS = MRGR
      GO TO 2010
 1060 CONTINUE
C-----MTURN=6 THUS LEFT=Y STRAIGHT=Y RIGHT=N
C[    IF ( MRGS               .EQ.-2147483647   )STOP 'MAKECS MRGS   03'
      MRGR = MRGS
      GO TO 2010
 1070 CONTINUE
C-----MTURN=7 THUS LEFT=Y STRAIGHT=Y RIGHT=Y
      GO TO 2020
 2010 CONTINUE
C[    IF ( MRGL               .EQ.-2147483647   )STOP 'MAKECS MRGL   02'
C[    IF ( MRGR               .EQ.-2147483647   )STOP 'MAKECS MRGR   03'
C[    IF ( MRGS               .EQ.-2147483647   )STOP 'MAKECS MRGS   04'
      JSISET = KSISET(MRGL,MRGS,MRGR)
 2020 CONTINUE
C[    IF ( JSISET             .EQ.-2147483647   )STOP 'MAKECS JSISET 01'
      IF ( JSISET . LT . 0 )                     GO TO 9290
C[    IF ( K                  .EQ.-2147483647   )STOP 'MAKECS K      01'
      ISISET(KK,K) = JSISET
 2030 CONTINUE
      RETURN
C-----PROCESS THE EXECUTION ERROR AND STOP
 9290 CONTINUE
C[    IF ( K                  .EQ.-2147483647   )STOP 'MAKECS K      02'
      WRITE (ERRMSG,929) II,K,JJ,K
      CALL  ABORTR  ( ERRMSG )
      STOP  929
      END                                                               MAKECS
C
C
C
      SUBROUTINE HDWRCS
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CID'
      INCLUDE 'INDEX'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
C,    INTEGER           ICSO,ICSP,JCAMPS,JP
C
C-----SUBROUTINE HDWRCS BUILDS A CAMSTACK BAISED ON SIGNAL INTERVALS
C-----FROM EACH PHASE AND OVERLAP THAT WERE READ FROM THE HARDWARE
C-----IF ALL INTERVALS ARE UNCHANGED FROM LAST DT, DO NOTHING
C
C,    DO JP = 1,NPH
C,      IF ( SIGVP(JP) .NE. SIGV(JP) )       GO TO 100
C,    END DO
C-----NO CHANGE FROM LAST DT
C,    GO TO 200
C,100 CONTINUE
C,    ICSP = 0
C,    ICAMCT = 0
C,    DO JP = 1,NPH
C-----HARDWARE CONTROLLER MUST HAVE 1 OR 2 RINGS
C-----ONLY 1 PHASE ACTIVE PER RING
C,      IF (SIGV(JP) .EQ. INTERR)                THEN
C,        IF (SIGVP(JP) .EQ. INTERY)             THEN
C-----FIRST DT OF RED CLEARANCE
C,          ICSP = ICSP + 1
C,          ICAMCT(ICSP) = 0
C,        END IF
C,      ELSE IF (SIGV(JP) .EQ. INTERG)           THEN
C,        ICSP = ICSP + 1
C,        ICAMCT(ICSP) = ICAMPS(JP)
C,      ELSE IF (SIGV(JP) .EQ. INTERY)           THEN
C,        ICSP = ICSP + 1
C,        ICAMCT(ICSP) = ICAMPS(JP) + 1
C,      END IF
C,    END DO
C,    IF (ICSP .GT. 0)                           THEN
C,      SIGVP = SIGV
C,      ICAMPO=ICAMPC
C,      CALL TOGCS
C,      CALL MAKECS (ICAMCT(1),ICAMCT(2),ICAMPC)
C,    END IF
C,200 CONTINUE
C,    DO JP = 1,HOV
C,      IF ( SIGOP(JP) .NE. SIGO(JP) )           GO TO 300
C,    END DO
C-----NO CHANGE FROM LAST DT
C,    RETURN
C,300 CONTINUE
C,    ICSO = 0
C-----GREEN CAMSTACK FOR LAST PHASE
C,    JCAMPS = ICAMPS(LPHASE(NPHASE))
C,    DO JP = 1,HOV
C,      IF (SIGO(JP) .EQ. INTERR)                THEN
C,        ICSO = ICSO + 1
C,        ICAMCT(ICSO) = 0
C,      ELSE IF (SIGO(JP) .EQ. INTERG)           THEN
C,        ICSO = ICSO + 1
C,        ICAMCT(ICSO) = JCAMPS + JP + JP
C,      ELSE IF (SIGO(JP) .EQ. INTERY)           THEN
C,        ICSO = ICSO + 1
C,        ICAMCT(ICSO) = JCAMPS + JP + JP + 1
C,      END IF
C,    END DO
C,    IF (ICSO .GT. 0)                           THEN
C,      SIGOP = SIGO
C,      IF (ICSP .EQ. 0)                         THEN
C,        ICAMPO=ICAMPC
C,        CALL TOGCS
C,      END IF
C,      DO JP = 1,ICSO
C,        CALL MAKECS (ICAMPC,ICAMCT(JP),ICAMPC)
C,      END DO
C,    END IF
      RETURN
      END                                                               HDWRCS
C
C
C
      SUBROUTINE TOGCS
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'INTER'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'USER'
      INTEGER           MOV,P1,P2
C
C-----SUBROUTINE TOGCS TOGGLES THE CURRENT CAMSTACK POSITION BETWEEN
C-----THE LAST TWO POSITIONS FOR MULTI RING CONTROLLERS THAT
C-----DYNAMICALLY BUILD THE CAMSTACK.  IF ICAMPO NE ICAMPC,
C-----THE CAMSTACK POSITION IS NOT TOGGLED.
C
C*    NRNAME = NRNAME + 1
C*    IRNAME(NRNAME) = 'TOGCS'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
      IF(ICAMPC.NE.ICAMPO)                       GO TO 1010
      IF ( ICONTR . LT . ICNEMA )                THEN
C-----  PRETIMED, SEMI-ACT, FULL-ACT, TEX-DIA, AND DAL-DIA
        MOV = NOV
      ELSE
C-----  NEMA AND HARDWARE
        IF ( ICONTR . LT . ICHDWR )              THEN
C-----    NEMA
          MOV = NON
        ELSE
C-----    HARDWARE
          MOV = HOV
        END IF
      END IF
      P1 = NCM + MOV + MOV + 1
      P2 = P1              + 1
      IF(ICAMPC.EQ.P2)THEN
        ICAMPC=P1
      ELSE
        ICAMPC=P2
      END IF
 1010 CONTINUE
      RETURN
      END                                                               TOGCS
C
C
C
      SUBROUTINE OVLP
      IMPLICIT NONE                                                     CCODE=C.
      INCLUDE 'PARAMS'
      INCLUDE 'CLASS'
      INCLUDE 'INDEX'
      INCLUDE 'PHASES'
      INCLUDE 'QUE'
C*    INCLUDE 'RUTINE'
      INCLUDE 'SIGCAM'
      INCLUDE 'TXDSIG'
      INCLUDE 'USER'
      LOGICAL           OLY
C[    LOGICAL           OLYS
      INTEGER           I,IT1,IT3,IT4,J,K
C
C-----SUBROUTINE OVLP DETERMINES THE STATE OF OVERLAPS BASED ON THE
C-----ALGORITHM BELOW:
C
C-----OVERLAP IS GREEN WHEN:
C-----   1. ANY PHASE ON THE DEFINITION LIST IS GREEN
C-----               --- OR ---
C-----   2. ANY PHASE ON THE DEFINITION LIST IS IN YELLOW CHANGE AND
C-----      ANY PHASE ON THE DEFINITION LIST IS THE NEXT PHASE
C
C-----OVERLAP IS YELLOW CHANGE WHEN:
C-----   1. ANY PHASE ON THE DEFINITION LIST IS YELLOW CHANGE AND
C-----      NO PHASE ON THE DEFINITION LIST IS GREEN
C
C-----OVERLAP IS INACTIVE (RED) WHEN:
C-----   1. OVERLAP IS NOT GREEN AND OVERLAP IS NOT YELLOW CHANGE
C
C
C-----INTER  - CURRENT SIGNAL INTERVAL FOR EACH RING:
C-----         1 - GREEN
C-----         2 - YELLOW CHANGE
C-----         3 - RED CLEARANCE
C-----ICPHAT - CURRENT ACTIVE PHASE FOR EACH RING
C-----NEXT   - DIMENSIONED LOGICAL VARIABLE THAT INDICATES IF EACH PHASE
C-----         HAS BEEN SELECTED TO BE THE NEXT PHASE
C-----NOLP   - NUMBER OF OVERLAPS
C-----NOLDF  - DIMENSIONED, NUMBER OF PHASES IN EACH OVERLAP DEFINITION
C-----LOLDF  - DIMENSIONED, LIST OF PHASES IN EACH OVERLAP DEFINITION
C-----LOLP   - DIMENSIONED, CAMSTACK POSITION FOR GREEN ENTRY FOR THE OVERLAP
C-----IOVRLP - DIMENSIONED, STATE OF EACH OVERLAP:
C-----         0 - INACTIVE
C-----         1 - GREEN
C-----         2 - YELLOW
C
C[    OLYS       = .TRUE.
C[    I          = -2147483647
C[    IRING      = -2147483647
C[    IT1        = -2147483647
C[    IT3        = -2147483647
C[    IT4        = -2147483647
C[    J          = -2147483647
C[    K          = -2147483647
C*    NRNAME = NRNAME + 1
C*    IRNAME(NRNAME) = 'OVLP'
C*                  IF ( NRNAME . GT . NRNAMM )  CALL ABORTR ( MSG )
      DO 200 I=1,NOLP
C
C-----CHECK EACH OVERLAP
C
      OLY=.FALSE.
C[    OLYS       = .FALSE.
      IT4=NOLDF(I)
      DO 100 J=1,IT4
C
C-----CHECK EACH PHASE IN THE OVERLAP DEFINITION
C
      IT3=LOLDF(J,I)
      DO 60 IRING=1,NRING
      IF(ICPHAT(IRING).EQ.IT3)                   THEN
C
C-----PHASE FROM THIS RING IS IN THE DEFINITION
C
        IF(INTER(IRING).EQ.1)                                 GO TO  180
C
C-----PHASE IS IN YELLOW CHANGE
C
        DO 40 K=1,IT4
C
C-----IS A PHASE IN THE DEFINITION NEXT ?
C
        IF(NEXT(LOLDF(K,I)))                                  GO TO  180
   40   CONTINUE
C[      IF ( IRING            .EQ.-2147483647   )STOP 'OVLP   IRING  01'
        IF(INTER(IRING).EQ.2)                    THEN
          OLY=.TRUE.
C[        OLYS   = .FALSE.
        END IF
      END IF
   60 CONTINUE
  100 CONTINUE
C[    IF ( OLYS )                                STOP 'OVLP   OLY    01'
      IF(OLY)THEN
C
C-----OVERLAP IS YELLOW CHANGE
C
        IT1=2
      ELSE
C
C-----OVERLAP IS INACTIVE
C
        IT1=0
      END IF
                                                              GO TO  190
  180 CONTINUE
C
C-----OVERLAP IS GREEN
C
      IT1=1
  190 CONTINUE
C[    IF ( I                  .EQ.-2147483647   )STOP 'OVLP   I      01'
C[    IF ( IT1                .EQ.-2147483647   )STOP 'OVLP   IT1    01'
      IOVRLP(I)=IT1
      IF(IT1.EQ.0)                                            GO TO  200
      IT1=LOLP(I)-1+IT1
      CALL MAKECS(ICAMPC,IT1,ICAMPC)
  200 CONTINUE
      RETURN
      END                                                               OVLP
